改进运行缓慢的Excelmacros

我有一个macros比较，然后这个macros导出所有的变化基于信息不匹配。 我有它，以便每个列都在新的工作簿中获得自己的工作表。 我正在使用7个不同的计数整数，并且需要很长时间，因为我正在输出超过60k行。

问题：有没有更快的方法来执行此代码？ 可以使用UDF吗？ 如果是的话如何？

Sub Export_Updates() Dim ws As Worksheet Dim wb2 As Workbook Set wb = Application.Workbooks("Total Database Update_WORKING.xlsm") Set ws = wb.Worksheets("Results") Set wb2 = Application.Workbooks.Open("C:\Import Update.xlsx") i = 2 ii = 2 iii = 2 iiii = 2 iiiii = 2 iiiiii = 2 iiiiii = 2 k = 2 wb2.Activate Do While ws.Cells(k, 1) <> "" If ws.Cells(k, 4) = "No Match" Then wb2.Worksheets("AD UPDATE").Cells(i, 1) = ws.Cells(k, 1) wb2.Worksheets("AD UPDATE").Cells(i, 2) = ws.Cells(k, 2) i = i + 1 End If If ws.Cells(k, 7) = "No Match" Then wb2.Worksheets("SENIOR UPDATE").Cells(ii, 1) = ws.Cells(k, 1) wb2.Worksheets("SENIOR UPDATE").Cells(ii, 2) = ws.Cells(k, 5) ii = ii + 1 End If If ws.Cells(k, 10) = "No Match" Then wb2.Worksheets("ID UPDATE").Cells(iii, 1) = ws.Cells(k, 1) wb2.Worksheets("ID UPDATE").Cells(iii, 2) = ws.Cells(k, 8) iii = iii + 1 End If If ws.Cells(k, 13) = "No Match" Then wb2.Worksheets("MINOR UPDATE").Cells(iiii, 1) = ws.Cells(k, 1) wb2.Worksheets("MINOR UPDATE").Cells(iiii, 2) = ws.Cells(k, 11) End If If ws.Cells(k, 16) = "No Match" Then wb2.Worksheets("MAJOR UPDATE").Cells(iiii, 1) = ws.Cells(k, 1) wb2.Worksheets("MAJOR UPDATE").Cells(iiii, 2) = ws.Cells(k, 14) iiii = iiii + 1 End If If ws.Cells(k, 19) = "No Match" Then wb2.Worksheets("CAP UPDATE").Cells(iiiii, 1) = ws.Cells(k, 1) wb2.Worksheets("CAP UPDATE").Cells(iiiii, 2) = ws.Cells(k, 17) iiiii = iiiii + 1 End If If ws.Cells(k, 22) = "No Match" Then wb2.Worksheets("PL UPDATE").Cells(iiiiii, 1) = ws.Cells(k, 1) wb2.Worksheets("PL UPDATE").Cells(iiiiii, 2) = ws.Cells(k, 20) iiiiii = iiiiii + 1 End If k = k + 1 Loop wb2.Save Sleep (1000) wb2.Close SaveChanges:=True wb.Activate End Sub 

欢迎任何build议。

Answer 1

我build议使用VBAarrays来处理。 在Excel环境和VBA环境之间进行是一个缓慢的过程，对于每一行数据你要做多次。 使用VBAarrays的编程有一点点，但速度差异可能很大（60K行样本的速度是32倍）。

一般来说，最好的做法是

1. 使用2-D数组，一步就可以将所有数据从Excel读取到VBA数组中
2. 在VBA中处理数据，将结果存储在另一个VBA数组中
3. 最后，将VBA数组传回Excel

这里是一个示例工作簿，显示更多的细节。

这里是更快的VBA代码：

 Sub Method2() Dim ws As Worksheet Dim wsOutput As Worksheet Dim rngRawData As Range Dim rngOutput As Range Dim rngToDelete As Range Dim vaRawData() As Variant Dim vaDiffs() As Variant t = Timer Set ws = ActiveSheet Set rngRawData = ws.Range("A1").CurrentRegion ' Transfers Excel data to a VBA array in one step. vaRawData = rngRawData 'Loop through the VBA array, adding any No Match entries to the Diffs array ReDim vaDiffs(rngRawData.Rows.Count, 1 To 3) iDiffs = 0 For i = LBound(vaRawData, 1) To UBound(vaRawData, 1) If vaRawData(i, 4) = "No Match" Then iDiffs = iDiffs + 1 vaDiffs(iDiffs, 1) = vaRawData(i, 1) ' Capture the ID vaDiffs(iDiffs, 2) = vaRawData(i, 2) ' Capture the Source1 Value vaDiffs(iDiffs, 3) = vaRawData(i, 3) ' Capture the Source 2 value End If Next i 'Transfer the Diffs array back to excel Set wsOutput = Worksheets("Diff2") wsOutput.Range("A1") = vaDiffs 'Delete extra rows wsOutput.Cells(iDiffs + 2, 1) = "END" Set rngToDelete = wsOutput.Range(wsOutput.Cells(iDiffs + 2, 1), _ wsOutput.Cells(rngRawData.Rows.Count + 3, 1)) rngToDelete.EntireRow.Delete wsOutput.Activate MsgBox "It took " & Timer - t & " seconds." End Sub 

Answer 2

下面是一个快速将工作表单元格的所有内容放入数组的示例。 这将使您比使用大量单元格引用更快地处理信息。 相信我，我有一个超过10万行的工作簿，我必须阅读一些项目，我曾经遍历它来阅读它，现在我只是这样做，它花了总的时间，使其从一分钟或两秒钟。

 Dim WS As Excel.Worksheet Set WS = Excel.Workbooks(somebook).Worksheets(someworksheet) Dim arr() as variant arr = WS.UsedRange.Value 

在那里，你有它。 最好的部分是参考保持不变。 所以你曾经使用过

 wb2.Worksheets("AD UPDATE").Cells(i, 1) 

你现在可以使用

 arr(i, 1) 

或者无论你select什么来命名数组。 这使得我的许多项目更具性能。