VBA批量导入CSV至Excel遇数据倒三角错位问题求助

嘿，作为VBA新手能写出这样的批量导入代码已经很棒了！你遇到的倒三角错位问题，我帮你排查了下，主要是行号计算逻辑错误和未清理QueryTable残留导致的，咱们一步步来修复：

1. 最核心的问题：行号计算没有绑定目标工作表 #

你代码里的这一行是关键bug：

row = wks.Cells(Rows.Count, 1).End(xlUp).row

这里的Rows.Count默认会取当前激活的工作表的总行数，而不是你要导入的目标工作表wks的行数。比如你切换到其他工作表时，这个行号就会完全跑偏，导致每次导入的起始位置乱跳，最终形成倒三角的错位。

修复方式： #

把Rows.Count改成wks.Rows.Count，确保行号是从目标工作表的最后一行开始计算：

row = wks.Cells(wks.Rows.Count, 1).End(xlUp).Row

2. 次要但重要的问题：导入后未清理QueryTable #

每次用QueryTables导入CSV后，工作表里会留下一个QueryTable对象。这些残留的对象不仅会占用资源，还可能干扰后续的行号判断，导致导入位置偏移。

修复方式： #

在ImportCsv函数的.Refresh之后，添加一行删除QueryTable的代码：

.Refresh BackgroundQuery:=False
.Delete ' 新增这行，清理导入后残留的QueryTable

3. 额外优化：避免重复创建工作表报错 #

你的ImportFolderCsv里每次循环都会新建工作表，如果重复运行宏，会因为工作表名称重复报错。可以先判断工作表是否存在，不存在再创建：

For i = 1 To 1
    For j = 1 To 2
        Dim wsName As String
        wsName = CsvFolders(i) & Statuses(j)
        ' 先检查工作表是否存在
        On Error Resume Next
        Set ws = ThisWorkbook.Sheets(wsName)
        On Error GoTo 0
        ' 不存在就新建
        If ws Is Nothing Then
            Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
            ws.Name = wsName
        End If
        LoopThroughFolder RootFolder, CsvFolders(i), Statuses(j)
    Next j
Next i

修复后的完整代码 #

整合所有修改后的代码如下，你可以直接替换原来的代码：

Option Explicit

Private Function LoopThroughFolder(RootFolder As String, CsvFolder As String, Status As String)
    Dim folder As String, StrFile As String
    Dim wks As Worksheet
    folder = RootFolder & "\" & CsvFolder & "\" & Status
    StrFile = Dir(folder & "\*.csv")
    
    ' 提前获取目标工作表，避免循环内重复查找
    Set wks = ThisWorkbook.Worksheets(CsvFolder & Status)
    
    Do While Len(StrFile) > 0
        ImportCsv folder & "\" & StrFile, wks
        StrFile = Dir
    Loop
    'Debug.Print RootFolder & "\" & CsvFolder & "\" & Status & " >>> OK!"
End Function

Private Function ImportCsv(CsvFile As String, wks As Worksheet)
    Dim row&, col As Integer
    'Debug.Print CsvFile
    
    ' 修正行号计算，绑定到目标工作表
    row = wks.Cells(wks.Rows.Count, 1).End(xlUp).Row
    
    With wks.QueryTables _
        .Add(Connection:="TEXT;" & CsvFile, Destination:=wks.Cells(row + 1, 1))
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850 ' 如果CSV是UTF-8编码，改成65001避免乱码
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
        .Delete ' 清理残留的QueryTable
    End With
End Function

Public Sub ImportFolderCsv()
    Dim RootFolder As String
    RootFolder = "C:\Users\chinkai\Desktop\dims investigate"
    
    Dim CsvFolders(1 To 2) As String
    CsvFolders(1) = "csvVeh"
    CsvFolders(2) = "csvCust"
    
    Dim Statuses(1 To 2) As String
    Statuses(1) = "FAIL"
    Statuses(2) = "PASS"
    
    Dim i As Integer, j As Integer
    Dim ws As Worksheet
    
    For i = 1 To 1
        For j = 1 To 2
            Dim wsName As String
            wsName = CsvFolders(i) & Statuses(j)
            
            ' 检查工作表是否已存在
            On Error Resume Next
            Set ws = ThisWorkbook.Sheets(wsName)
            On Error GoTo 0
            
            If ws Is Nothing Then
                Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
                ws.Name = wsName
            End If
            
            LoopThroughFolder RootFolder, CsvFolders(i), Statuses(j)
        Next j
    Next i
End Sub

小提示 #

• 如果你的CSV文件是UTF-8编码，记得把.TextFilePlatform = 850改成.TextFilePlatform = 65001，防止中文乱码。
• 可以先测试导入1-2个CSV文件，确认位置正确后再批量导入哦！

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