VBA 代码优化:提升运行速度的技巧
以下是优化后的 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 之间的交互,从而提高程序的运行速度。同时,我们使用了一些技巧来避免重复的操作,比如在获取数据的时候就顺便获取了每个文件的行数,这样就避免了在写入数据的时候再去计算行数。在将数据写入到目标表格中时,我们也使用了数组来存储数据,这样可以一次性地将数据写入到目标表格中,避免了循环写入的操作。
原文地址: https://www.cveoy.top/t/topic/mywo 著作权归作者所有。请勿转载和采集!