使用VBA将CSV导入Excel表格时表格移位问题求助

你的代码出现表格被挤到右侧、数据未存入表格的核心原因是：直接用QueryTable向表格的DataBodyRange写入数据时，QueryTable是独立于表格结构的单元格写入操作，会覆盖表格所在的单元格区域，导致原有表格被挤压移位，且数据无法被表格识别为自身内容。

修复方案 #

核心修改点：

• 彻底删除表格的所有数据行（而非仅清空内容），让表格仅保留表头
• 将CSV数据导入到表头的下一行，Excel会自动将导入的数据纳入表格范围，表格会自动扩展适配数据

修复后的完整代码 #

Sub ImportCSVToTable()
    Dim folderPath As String
    Dim fileNameStart As String
    Dim fullFileName As String
    Dim lastDayPrevMonth As String
    Dim filePath As String
    Dim ws As Worksheet
    Dim tbl As ListObject
    Dim queryTable As QueryTable
    Dim destinationRange As Range
    
    ' 设置文件所在文件夹路径
    folderPath = "C:\ZAINET_CLIENT\ODBS\"
    
    ' 指定目标工作表
    Set ws = ThisWorkbook.Sheets("Aligne extract")
    
    ' 检查工作表是否存在表格
    If ws.ListObjects.Count < 1 Then
        MsgBox "Aligne extract工作表中未找到表格。", vbExclamation, "表格未找到"
        Exit Sub
    End If
    
    ' 获取目标表格
    Set tbl = ws.ListObjects(1)
    
    ' 计算上月最后一天
    lastDayPrevMonth = Format(DateSerial(Year(Date), Month(Date), 0), "ddmmmyy")
    
    ' 构建文件名前缀
    fileNameStart = "IT_WEDGE_PL_DETAIL_1_" & lastDayPrevMonth
    
    ' 查找匹配的CSV文件
    fullFileName = Dir(folderPath & fileNameStart & "*.csv")
    
    ' 检查文件是否存在
    If fullFileName = "" Then
        MsgBox folderPath & "路径下未找到匹配文件。", vbExclamation, "文件未找到"
        Exit Sub
    End If
    
    ' 拼接完整文件路径
    filePath = folderPath & fullFileName
    
    ' 删除表格所有数据行（仅保留表头）
    If Not tbl.DataBodyRange Is Nothing Then
        tbl.DataBodyRange.Delete
    End If
    
    ' 设置导入目标区域：表头下第一行的第一个单元格
    Set destinationRange = tbl.HeaderRowRange.Offset(1, 0).Cells(1, 1)
    
    ' 导入CSV数据到表格
    With ws.QueryTables.Add(Connection:="TEXT;" & filePath, Destination:=destinationRange)
        .TextFileParseType = xlDelimited
        .TextFileCommaDelimiter = True ' 按逗号分隔
        .TextFileColumnDataTypes = Array(1) ' 所有列设为常规格式
        .TextFileSkipRows = 1 ' 如果CSV包含表头，跳过第一行；无表头则注释此行
        .Refresh BackgroundQuery:=False ' 执行导入
        .Delete ' 移除QueryTable，保留静态数据
    End With
    
    MsgBox "CSV文件导入成功：" & fullFileName, vbInformation, "导入完成"
End Sub

关键修改说明 #

1. 替换清空逻辑：将tbl.DataBodyRange.ClearContents改为tbl.DataBodyRange.Delete，彻底删除数据行，避免原有行干扰导入操作
2. 调整目标区域：从tbl.DataBodyRange.Cells(1,1)改为tbl.HeaderRowRange.Offset(1,0).Cells(1,1)，确保数据导入到表头下方，触发表格自动扩展
3. 可选表头跳过：添加.TextFileSkipRows = 1，如果你的CSV文件包含表头行，必须启用此行避免重复表头；若CSV无表头则注释掉

内容的提问来源于stack exchange，提问作者r.baton