Excel VBA 优化：快速处理几十万行数据 - 成本核算数据整合 - 常规

Excel VBA 优化：快速处理几十万行数据 - 成本核算数据整合

表格有几十万行数据，这行代码怎么优化内容？对于处理几十万行数据的情况，可以考虑一些优化策略来提高代码的执行效率。以下是几点优化建议：

减少对单元格的读写操作: 在循环中，对单元格的读写操作会比较耗时，尤其是在大数据集的情况下。建议在循环之前先将数据加载到数组中，然后在循环中直接操作数组，最后再将结果写入到单元格。
禁用屏幕更新和自动计算: 在处理大数据集时，禁用屏幕更新和自动计算可以提高代码的执行速度。在代码开始之前，使用 Application.ScreenUpdating = False 和 Application.Calculation = xlCalculationManual 来禁止屏幕更新和自动计算，在代码结束时恢复为默认值。
批量操作数据: 尽量避免在循环中对单个单元格进行操作，而是采用批量操作数据的方式。例如，可以使用 Range.Value 属性来一次性读取或写入一整列或一整行的数据。
使用合适的数据结构: 根据实际需求，选择合适的数据结构来存储和处理数据。例如，使用数组、集合或字典等数据结构，可以提高处理效率。
使用更高效的查找方法: 对于大数据集，使用 Find 方法进行查找可能会效率较低。可以考虑使用其他更高效的查找方法，如通过排序后使用二分查找。
分批处理数据: 如果可能，可以将数据进行分批处理，避免一次性处理所有数据。这样可以减少内存占用和提高代码执行速度。

综上所述，根据具体情况，结合以上优化建议来对代码进行优化，可以提高处理大数据集的效率。

代码示例:

Private Sub CommandButton1_Click()
    Call 启动
    Dim response As String
    Dim cck40n(1 To 10) As Integer
    Dim date1 As Integer
    Dim rloop As Long
    Dim searchrange As Range, foundcell As Range, loops As String
    Dim ws As Worksheet
    path = InputBox("输入' & st & '文件路径", "请输入")
    wbname(2) = InputBox("输入' & st & '文件名（带文件格式）", "请输入")
    date1 = InputBox("输入年月（如2301）", "请输入")
    On Error Resume Next
    Workbooks.Open (path & "\" & wbname(2))
    If Err.Number > 0 Then
        response = MsgBox("指定文件不存在", vbOKOnly Or vbCritical)
        Err.Clear
        End
    End If
    Set wbaddress(2) = Workbooks(wbname(2))
    Set arange = wbaddress(2).Worksheets(1).Range("1:1")
    cck40n(1) = Application.Match("物料", arange, 0)
    cck40n(2) = Application.Match("物料描述", arange, 0)
    cck40n(3) = Application.Match("工厂", arange, 0)
    cck40n(4) = Application.Match("成本核算结果", arange, 0)
    cck40n(5) = Application.Match("固定成本核算结", arange, 0)
    cck40n(6) = Application.Match("成本核算批量", arange, 0)
    cck40n(7) = Application.Match("基本计量单位", arange, 0)
    Set arange = wbaddress(1).Worksheets(1).Range("1:1")
    chz(4) = Application.Match(date1, arange, 0)
    rtotal(2) = wbaddress(2).Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
    Set ws = wbaddress(2).Worksheets(1)
    ' 禁用屏幕更新和自动计算
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    ' 将数据加载到数组
    Dim dataArray() As Variant
    dataArray = ws.Range(ws.Cells(2, 1), ws.Cells(rtotal(2), ws.Columns.Count)).Value
    ' 处理数据
    For rloop = 2 To rtotal(2)
        With wbaddress(1).Worksheets(CStr(dataArray(rloop, cck40n(3))))
            rtotal(1) = .Cells(Rows.Count, 1).End(xlUp).Row
            If rtotal(1) = 1 Then
                rtotal(1) = 2
            End If
            Set foundcell = .Range(.Cells(2, chz(1)), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, chz(1))).Find(dataArray(rloop, cck40n(1)), LookIn:=xlValues, LookAt:=xlWhole)
            If Not foundcell Is Nothing Then
                .Cells(foundcell.Row, chz(2)) = dataArray(rloop, cck40n(2))
                .Cells(foundcell.Row, chz(4)) = dataArray(rloop, cck40n(5)) / dataArray(rloop, cck40n(6))
                .Cells(foundcell.Row, chz(4) + 1) = (dataArray(rloop, cck40n(5)) - dataArray(rloop, cck40n(5))) / dataArray(rloop, cck40n(6))
                .Cells(foundcell.Row, chz(4) + 2) = dataArray(rloop, cck40n(7))
            Else
                rtotal(1) = rtotal(1) + 1
                .Cells(rtotal(1), chz(1)) = dataArray(rloop, cck40n(1))
                .Cells(rtotal(1), chz(2)) = dataArray(rloop, cck40n(2))
                .Cells(rtotal(1), chz(4)) = dataArray(rloop, cck40n(5)) / dataArray(rloop, cck40n(6))
                .Cells(rtotal(1), chz(4) + 1) = (dataArray(rloop, cck40n(4)) - dataArray(rloop, cck40n(5))) / dataArray(rloop, cck40n(6))
                .Cells(rtotal(1), chz(4) + 2) = dataArray(rloop, cck40n(7))
            End If
        End With
    Next
    ' 恢复屏幕更新和自动计算
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Call 结束
End Sub

说明:

以上代码示例展示了如何使用数组来提高数据处理效率，并禁用屏幕更新和自动计算以提高代码执行速度。
具体代码需要根据实际情况进行调整。

希望以上内容对您有所帮助。如有任何其他问题，请随时提问。

注意:

代码中使用 ' & st & ' 的部分需要根据实际情况替换为相应的变量或字符串。
为了方便阅读，代码中的双引号已替换为单引号。