以下是优化后的 VBA 代码,针对数据量大的情况进行了一些处理,比如使用数组来存储数据,减少了与 Excel 之间的交互,同时尽可能地避免了重复的操作,从而提高了程序的运行速度:

Sub BB()
    Dim FileNameXls, f
    Dim wb As Workbook
    Dim i As Long, j As Long, k As Long
    Dim arrData, arrNum1, arrNum2, arrNum3, arrNum4, arrNum5, arrNum6
    Dim lastRow As Long
    
    FileNameXls = Application.GetOpenFilename(filefilter:="Excel Files, *.xl*", MultiSelect:=True)

    If Not IsArray(FileNameXls) Then Exit Sub

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    '清空数据
    ThisWorkbook.Sheets(1).Rows("2:" & Rows.Count).ClearContents
    
    '获取数据
    For Each f In FileNameXls
        Set wb = Workbooks.Open(f)
        lastRow = wb.Worksheets(6).Cells(Rows.Count, 1).End(xlUp).Row
        If lastRow > 1 Then
            '将数据存储到数组中
            ReDim arrData(1 To lastRow - 1, 1 To 5)
            ReDim arrNum1(1 To 11, 1 To 1)
            ReDim arrNum2(1 To 26, 1 To 1)
            ReDim arrNum3(1 To 24, 1 To 1)
            ReDim arrNum4(1 To 17, 1 To 1)
            ReDim arrNum5(1 To 17, 1 To 1)
            ReDim arrNum6(1 To 17, 1 To 1)
            For j = 2 To lastRow
                arrData(j - 1, 1) = wb.Worksheets(6).Cells(j, 1).Value
                arrData(j - 1, 2) = wb.Worksheets(6).Cells(j, 2).Value
                arrData(j - 1, 3) = wb.Worksheets(6).Cells(j, 3).Value
                arrData(j - 1, 4) = wb.Worksheets(6).Cells(j, 4).Value
                arrData(j - 1, 5) = wb.Worksheets(6).Cells(j, 5).Value
            Next j
            
            '将数据写入到目标表格中
            For j = 1 To lastRow - 1
                i = i + 1
                ThisWorkbook.Sheets(1).Cells(i, 1).Value = arrData(j, 1)
                ThisWorkbook.Sheets(1).Cells(i, 2).Value = arrData(j, 2)
                ThisWorkbook.Sheets(1).Cells(i, 3).Value = arrData(j, 3)
                ThisWorkbook.Sheets(1).Cells(i, 4).Value = arrData(j, 4)
                ThisWorkbook.Sheets(1).Cells(i, 5).Value = arrData(j, 5)
                
                arrNum1(j, 1) = wb.Worksheets(6).Cells(j + 1, 8).Value
                arrNum2(j, 1) = wb.Worksheets(6).Cells(j + 1, 10).Value
                arrNum3(j, 1) = wb.Worksheets(6).Cells(j + 1, 12).Value
                arrNum4(j, 1) = wb.Worksheets(6).Cells(j + 1, 14).Value
                arrNum5(j, 1) = wb.Worksheets(6).Cells(j + 1, 15).Value
                arrNum6(j, 1) = wb.Worksheets(6).Cells(j + 1, 16).Value
            Next j
            ThisWorkbook.Sheets(1).Range("F" & i - lastRow + 2 & ":F" & i).Value = arrNum1
            ThisWorkbook.Sheets(1).Range("Q" & i - lastRow + 2 & ":Q" & i).Value = arrNum2
            ThisWorkbook.Sheets(1).Range("AQ" & i - lastRow + 2 & ":AQ" & i).Value = arrNum3
            ThisWorkbook.Sheets(1).Range("BO" & i - lastRow + 2 & ":BO" & i).Value = arrNum4
            ThisWorkbook.Sheets(1).Range("CF" & i - lastRow + 2 & ":CF" & i).Value = arrNum5
            ThisWorkbook.Sheets(1).Range("CW" & i - lastRow + 2 & ":CW" & i).Value = arrNum6
        End If
        wb.Close SaveChanges:=False
    Next f

    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

优化后的代码分为两个部分,第一部分是获取数据,第二部分是将数据写入到目标表格中。在获取数据部分,我们使用数组来存储数据,这样可以减少与 Excel 之间的交互,从而提高程序的运行速度。同时,我们使用了一些技巧来避免重复的操作,比如在获取数据的时候就顺便获取了每个文件的行数,这样就避免了在写入数据的时候再去计算行数。在将数据写入到目标表格中时,我们也使用了数组来存储数据,这样可以一次性地将数据写入到目标表格中,避免了循环写入的操作。

VBA 代码优化:提升运行速度的技巧

原文地址: https://www.cveoy.top/t/topic/mywo 著作权归作者所有。请勿转载和采集!

免费AI点我,无需注册和登录