vba - 从 CSV -> excel 单元格移动数据的效率问题

Question

我在两天前开始使用 VBA - 编程，由于我对 VBA 和 EXCEL 的了解有限，我遇到了效率问题。

我正在将数据从.CSV 移动到 .xlsm 文件。我收到的 .CSV 文件的结构为 SHEET;COL;ROW;VALUE.

然后将此 .CSV 读取到多维数组并使用以下内容填充 excel 文件wb.Worksheets(ARRAY(i, SHEET)).Cells(R,C) = ARRAY(i, VALUE)

据我了解，将数组应用于一系列单元格不起作用，因为我没有将每个单独的 .csv 行发送到的连续表面。

我尝试过的大部分内容可以在下面看到。我相信我遇到的一个大问题是每个 .CSV 行的 VBA -> EXCEL 之间的传递。有什么办法可以批量完成吗？

非常感谢有关 VBA 中的效率和一般操作方法的所有类型的评论！

Option Explicit
Private Sub imp_Data()
    '----------------------------File Dialog for data input-----------------
    Dim Valarr As Variant
    Dim fullpath As String
    Dim CSVSHEET As Integer, CSVCOL As Integer, CSVROW As Integer, CSVVALUE As Integer

    fullpath = [YOUR TEST FILE.CSV]
    '----------------------------Read rawdata----------------------------
    Dim RawData As String
    Open fullpath For Binary As #1
    RawData = Space$(LOF(1))
    Get #1, , RawData
    Close #1

    '----------------------------Split rawdata into array-------------------
    Dim r As Long, Nrow As Long, Ncol As Long
    Dim c As Integer
    Dim lineArr As Variant, cellArr As Variant
    If Len(RawData) > 0 Then
        'Split each row in CSV to str array
        lineArr = Split(Trim$(RawData), vbCrLf)
        'Dim final array
        Nrow = UBound(lineArr) + 1
        Ncol = UBound(Split(lineArr(0), ";")) + 1
        ReDim Valarr(1 To Nrow, 1 To Ncol)
        'Split each col on delimiter ";"
        For r = 1 To Nrow
            If Len(lineArr(r - 1)) > 0 Then
                cellArr = Split(lineArr(r - 1), ";")
                For c = 1 To Ncol
                    Valarr(r, c) = cellArr(c - 1)
                Next c
            End If
        Next r
    Else
        Debug.Print "No data read"
        ' do more stuff
    End If

    '----------------------------Read Table positions-----------------------
    Dim i As Integer

    For i = 1 To Ncol
        If UCase(Valarr(1, i)) = "SHEET" Then
            CSVSHEET = i
        ElseIf UCase(Valarr(1, i)) = "COL" Then
            CSVCOL = i
        ElseIf UCase(Valarr(1, i)) = "ROW" Then
            CSVROW = i
        ElseIf UCase(Valarr(1, i)) = "VALUE" Then
            CSVVALUE = i
        End If
    Next i
    'Turn off calculation and screen update for efficiency
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False


    '--------------------------------------------Send data to Cells----------
    Dim L As Long
    Dim wb As Workbook
    Set wb = ThisWorkbook 
    L = UBound(Valarr, 1) - LBound(Valarr, 1) + 1
    For i = 2 To L
        If IsEmpty(Valarr(i, 1)) = 0 Then
            wb.Worksheets(Valarr(i, CSVSHEET)).Cells(Valarr(i, CSVROW), Valarr(i, CSVCOL)) = Valarr(i, CSVVALUE)
        End If
    Next i

    'Release ValArr memory
    ReDim Valarr(0)
    Erase Valarr

    'Reapply calculation/screen update
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

从 100 万行的测试开始，将数据读取到数组需要 14 秒，将数据移动到指定单元需要 5 分钟以上。所以下面代码中的问题是（我相信）

For i = 2 To L
  If IsEmpty(Valarr(i, 1)) = 0 Then
      wb.Worksheets(Valarr(i, CSVSHEET)).Cells(Valarr(i, CSVROW), Valarr(i, CSVCOL)) = Valarr(i, CSVVALUE)
   End If
Next i

标签： vba