VBA宏开发求助：多CSV文件数据转置合并至原工作簿

作为VBA新手，你已经找对了核心思路，不过代码里有几个细节问题导致功能没法正常运行，我帮你梳理并修正了代码，同时加入了一些实用的鲁棒性处理：

原代码的主要问题 #

• 引用用户选择的范围时错误用了字符串 "UserRange"，应该直接使用变量 UserRange
• 粘贴位置的写法 tWB.Sheets(1).Range.Cells(i, 1) 不符合VBA语法，需要明确起始单元格
• 转置时错误用了整个数组 A，应该针对每个CSV提取的单列数据 A(i) 进行转置
• 缺少用户取消操作（比如取消选文件或取消选范围）的处理逻辑
• 不必要的工作簿激活操作可以优化，提升代码效率

修正后的完整代码 #

Option Explicit
Option Base 1

Sub ExtractAndTransposeCSVColumns()
    Dim FileNames() As Variant
    Dim i As Integer
    Dim targetWB As Workbook, sourceWB As Workbook
    Dim userSelectedRange As Range
    Dim pasteStartCell As Range
    
    ' 设置目标工作簿（即运行宏的当前工作簿）
    Set targetWB = ThisWorkbook
    ' 设置粘贴起始位置，这里默认是Sheet1的A1单元格，可根据需求调整
    Set pasteStartCell = targetWB.Sheets(1).Range("A1")
    
    ' 让用户选择多个CSV文件
    FileNames = Application.GetOpenFilename("CSV Files (*.csv),*.csv", , "选择CSV文件", , True)
    ' 处理用户取消选择文件的情况
    If TypeName(FileNames) = "Boolean" Then
        MsgBox "未选择任何文件，宏已终止。"
        Exit Sub
    End If
    
    ' 让用户选择需要提取的列范围（仅需选择一次）
    On Error Resume Next
    Set userSelectedRange = Application.InputBox("请选择需要提取的列范围（单个列）：", "范围选择", Type:=8)
    On Error GoTo 0
    ' 处理用户取消选择范围的情况
    If userSelectedRange Is Nothing Then
        MsgBox "未选择有效范围，宏已终止。"
        Exit Sub
    End If
    ' 可选验证：确保用户选择的是单个列
    If userSelectedRange.Columns.Count > 1 Then
        MsgBox "请仅选择单个列范围，宏已终止。"
        Exit Sub
    End If
    
    ' 关闭屏幕刷新，提升运行速度
    Application.ScreenUpdating = False
    
    ' 遍历每个选中的CSV文件
    For i = 1 To UBound(FileNames)
        ' 打开CSV文件
        Set sourceWB = Workbooks.Open(FileNames(i))
        ' 提取选中列的数据，转置后粘贴到目标工作簿的对应行
        pasteStartCell.Offset(i - 1, 0).Resize(1, userSelectedRange.Rows.Count).Value = _
            WorksheetFunction.Transpose(sourceWB.Sheets(1).Range(userSelectedRange.Address))
        ' 关闭源CSV文件，不保存更改
        sourceWB.Close SaveChanges:=False
    Next i
    
    ' 恢复屏幕刷新
    Application.ScreenUpdating = True
    MsgBox "数据提取完成！"
End Sub

关键改进点说明 #

• 鲁棒性处理：加入了用户取消选择文件/范围的判断，避免宏因误操作报错终止
• 范围引用修正：直接使用 userSelectedRange.Address 确保每个CSV都提取相同的列
• 粘贴逻辑优化：用 Offset(i - 1, 0) 定位每一行的粘贴起始位置，Resize 保证粘贴的行长度和提取的列长度一致
• 减少激活操作：直接通过工作簿对象操作，避免使用 Activate，提升代码稳定性和效率
• 列验证：可选的验证步骤确保用户选择的是单个列，符合你需求中的"列向量"要求

你可以直接复制这段代码到VBA编辑器中测试，运行前记得先保存好目标工作簿哦！

内容的提问来源于stack exchange，提问作者Hols Muller