VBA和Excel优化脚本，处理700,000行

你好，StackOverflowers，

我目前正在处理一个embedded了IF语句的脚本。 运行时，可能会计算大约140万中频。

我已经用一个定时器（不太确定定时器在VBA中的精确度）运行一个testing，捣鼓1000行给我10秒的时间。 10 * 700 = 7000秒，这= 1.94小时。

任何人都可以给我任何处理这种大型数据集优化技巧？

我的代码如下

Sub itS1Capped() Dim Start, Finish, TotalTime Start = Timer Dim c, d, j, lastRow c = 1 'find how many rows With Worksheets("Data") lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row End With 'loop through all rows For Each d In Worksheets("Data").Range("D2:D" & lastRow).Cells 'd = IT S0 Uncapped j = Worksheets("Data").Range("J" & c + 1).Value 'IT Cap If j <> 0 Then If d > j Then Worksheets("Data").Range("K" & c + 1).Value = j 'IT S1 Capped = j Else Worksheets("Data").Range("K" & c + 1).Value = d 'IT S1 Capped = d End If Else Worksheets("Data").Range("K" & c + 1).Value = d 'IT S1 Capped = d End If c = c + 1 Next Finish = Timer TotalTime = Finish - Start MsgBox TotalTime End Sub 

Answer 1

我有点老派，所以“arrays”是你的朋友:-)当我第一次接pipe了一些非常复杂的电子表格，在做大量的validation工作时，也遇到了类似的问题。 处理大量数据时，不build议在工作簿和工作表上的数据之间移动，因为每个操作实际上都是I / O（input/输出）操作，这些操作非常耗时。 将所有数据读入数组，处理数组数据，然后将其写回到表单中，这样会更有效率，如果每次读取表单数据，则实际上是2个I / O，而不是700,000个。 作为一个粗略的例子，我使用这种方法将以前的validation时间从25分钟减less到了4秒。

 Sub ValidateSheet() Dim DataRange As String Dim SheetArray As Variant Dim StartCol As String Dim EndCol As String Dim StartRow As Long ' long to cope with over 32k records Dim lastrow As Long Dim WorksheetToRead As String Dim ArrayLoopCounter As Long Dim Start, Finish, TotalTime Start = Timer 'I use variables for the data range simply to allow it to be changed easily. My real code is actually paramatised so a single reusable procedure 'is used to populate all my arrays 'find how many rows WorksheetToRead = "Data" StartCol = "A" EndCol = "Z" StartRow = 1 lastrow = Sheets(WorksheetToRead).Cells(Rows.Count, "A").End(xlUp).Row 'set the range to be read into the array DataRange = StartCol & Trim(Str(StartRow)) & ":" & EndCol & Trim(Str(StartRow - 1 + lastrow)) SheetArray = Worksheets(WorksheetToRead).Range(DataRange).Value ' read all the values at once from the Excel grid, put into an array 'Loop around the data For ArrayLoopCounter = LBound(SheetArray, 1) To UBound(SheetArray, 1) If SheetArray(ArrayLoopCounter, 10) <> 0 Then '10 is column J 'Compare D with J If SheetArray(ArrayLoopCounter, 4) > SheetArray(ArrayLoopCounter, 10) Then '10 is column J SheetArray(ArrayLoopCounter, 11) = SheetArray(ArrayLoopCounter, 10) 'set col K = Col J Else SheetArray(ArrayLoopCounter, 11) = SheetArray(ArrayLoopCounter, 4) 'set col K = Col D End If Else SheetArray(ArrayLoopCounter, 11) = SheetArray(ArrayLoopCounter, 4) 'set col K = Col D End If Next ArrayLoopCounter 'Write the updated array back to the sheet Worksheets(WorksheetToRead).Range(DataRange) = SheetArray Finish = Timer TotalTime = Finish - Start MsgBox TotalTime End Sub 

Answer 2

所以我从Mark Moore的数组使用中获得灵感，发现使用数组函数而不是在一个范围内复制和粘贴一个普通函数要快得多。 在我的机器上，Mark的程序在2.2秒内运行，而在1.4秒内运行。

 Sub FormulaArray() Dim iUsedRows As Long, rCell As Range, StartTimer As Double, Duration As Double StartTimer = Timer iUsedRows = ActiveSheet.UsedRange.Cells(ActiveSheet.UsedRange.Rows.Count, 1).Row With Range(Cells(1, 11), Cells(iUsedRows, 11)) .FormulaArray = "=IF(J:J<>0,IF(D:D>J:J,J:J,D:D),D:D)" .Copy .PasteSpecial xlPasteValues End With Duration = StartTimer - Timer MsgBox Format(Duration, "#0.0000") & " seconds to run" End Sub 

Answer 3

我现在不能testing，但是我相信如果你编写一个函数来replace嵌套的IF语句，把它添加到范围（“K2”）

 Range("K2").Formula = ... 

然后将其复制到单元格（lastrow，“K”），复制所有function并粘贴为值将会快得多。

当然使用

 Application.Calculation = xlCalculationManual 

和

 Application.Calculation = xlCalculationAutomatic 

就像敌人所build议的一样

 Application.screenupdate = false 

可能会稍微快一点，但我认为function复制粘贴会造成最大的差异。

目前我没有时间发布更新后的代码，但希望明天我能明白。

希望有所帮助！

编辑：这是修改后的代码

警告：我还没有能够testing这个代码呢。 我明天会这样做，如果需要的话修改。

 Sub FunctionCopyPaste() Dim iLastRow as Integer With Worksheets("Data") iLastRow = .UsedRange.Cells(.UsedRange.Rows.Count,1).Row .Range("K2").Formula = "=IF(J2<>0,IF(D2>J2,J2,D2),D2)" .Range("K2").Copy Range(Cells(2,4), Cells(iLastRow,1).Row,4)) End With With Range(Cells(2,4), Cells(iLastRow,4)) .Copy .PasteSpecial xlPasteValues End With End Sub 

Answer 4

我不确定它是否会有所作为，但是由于您正在计时，所以我有兴趣知道。

我稍微修改了你的代码。 主要变化是对于工作表中的每个D. 否则，我使用单元格（行，列），而不是范围。 不是我期待这种改变来节省时间，我只是想你可能会喜欢另一种定义单元格的方式，而不是串联字母和数字。
注意：对于单元格，您可以使用所有variables和数字，而不使用字母。 我只是用字母来表示相似之处。

另外，既然你在每一行都有一个AC + 1，为什么不从第二行开始，省略了多个（+ 1），然后从那里走？

UN-TESTED

 Sub itS1Capped() Dim Start, Finish, TotalTime 'What are you declaring these variables as? Dim c, d, j, lastRow Start = Timer 'find how many rows lastRow = Sheets("Data").Cells(Rows.Count, "A").End(xlUp).row 'loop through all rows For c = 2 To lastRow 'c = IT S0 Uncapped (OLD d) j = Sheets("Data").Cells(c, "J").Value 'IT Cap = Cells(c, 10) If j <> 0 Then If c > j Then Sheets("Data").Cells(c, "K").Value = j 'IT S1 Capped = j Else Sheets("Data").Cells(c, "K").Value = c 'IT S1 Capped = c End If Else Sheets("Data").Cells(c, "K").Value = c 'IT S1 Capped = c End If Next c Finish = Timer TotalTime = Finish - Start MsgBox TotalTime End Sub 

编辑：用c代替d

Answer 5

您是否曾尝试在运行脚本之前closures自动重新计算？

 Application.Calculation = xlCalculationManual 

当你完成后再打开它？

 Application.Calculation = xlCalculationAutomatic 

这通常会加速大量行的处理，假设您在处理下一行（或后续）之前未更改需要重新计算的内容。