【Excel VBA编程】将CSV文件数据导入到结构化表格中,公式仍能自动填充

Sub ExportCSVToMyTables()    Dim fso As Object    Dim filePath As String    Dim lineText As String    Dim dataArray() As String    Dim dataCollection As Collection    Dim itemArray(1 To 4) As Variant ' 用于存储每行的A~D列    Dim finalData() As Variant    Dim i As Long, j As Long, rowIndex As Long    Dim targetSheet As Worksheet    Dim myTable As ListObject    On Error GoTo ErrorHandler    Application.ScreenUpdating = False    ' 选择CSV文件    filePath = Application.GetOpenFilename("CSV Files (*.csv), *.csv", , "选择数据源文件")    If filePath = "False" Then Exit Sub    '读取并处理CSV文件    Set dataCollection = New Collection    Open filePath For Input As #1    rowIndex = 0    Do While Not EOF(1)        Line Input #1, lineText        rowIndex = rowIndex + 1        dataArray = Split(lineText, ",")        ' 提取A~D列（前四列）。如果某行列数不足，用空值填充        For j = 1 To 4            If UBound(dataArray) >= (j - 1) Then                itemArray(j) = dataArray(j - 1)            Else                itemArray(j) = ""            End If        Next j        ' 将本行数据加入集合（跳过表头，假设第一行是表头）        If rowIndex > 1 Then            dataCollection.Add Array(itemArray(1), itemArray(2), itemArray(3), itemArray(4))        End If    Loop    Close #1    ' 将集合转换为二维数组，便于写入    If dataCollection.Count > 0 Then        ReDim finalData(1 To dataCollection.Count, 1 To 4)        For i = 1 To dataCollection.Count            For j = 1 To 4                finalData(i, j) = dataCollection(i)(j - 1)            Next j        Next i    Else        MsgBox "CSV文件中未找到有效数据（除表头外）。", vbInformation        Exit Sub    End If    ' 定位“MyTables”表格并写入数据    Set targetSheet = ThisWorkbook.Worksheets("销售报表") ' 根据实际情况修改工作表名称    Set myTable = targetSheet.ListObjects("MyTables")    If myTable Is Nothing Then        MsgBox "当前工作簿中未找到名为‘MyTables’的表格。请检查表格名称是否正确。", vbCritical        Exit Sub    End If    ' 清空旧数据    If Not myTable.DataBodyRange Is Nothing Then        'myTable.DataBodyRange.ClearContents        myTable.DataBodyRange.Columns(1).Resize(, 4).ClearContents    End If    ' 写入新数据    If dataCollection.Count > 0 Then        myTable.HeaderRowRange.Offset(1, 0).Resize(UBound(finalData, 1), UBound(finalData, 2)).Value = finalData    End If    Application.ScreenUpdating = True    MsgBox "数据已成功从CSV文件导出至‘MyTables’表格！共导入 " & dataCollection.Count & " 行数据。", vbInformation    Exit SubErrorHandler:    Application.ScreenUpdating = True    MsgBox "运行时错误 " & Err.Number & ": " & Err.Description & vbCrLf & "请检查文件路径、格式及表格名称。", vbCriticalEnd Sub