Excel VBA，加快与数组的代码
在此先感谢任何帮助，我有一个大的电子表格，我需要parsing到其他电子表格，我有一些工作，虽然慢。 我读过使用数组是一个更好的方法，但我似乎无法得到它的工作，我想我可以将主电子表格拉到一个数组，但我不能像我想要的那样操作。 具体来说，我不能从主数组中获取某些行，并将其插入到另一个数组中，以便在最后复制到目标表单中。 这里是原始的工作function：
Private Function CopyValues(rngSource As Range, rngTarget As Range) rngTarget.Resize(rngSource.Rows.Count, rngSource.Columns.Count).Value = rngSource.Value End Function Private Function RESORT(FROMSHEET As Variant, Column As Variant, TOSHEET As Variant, EXTRA1 As Variant, EXTRA2 As Variant, EXTRA3 As Variant) Set i = Sheets(FROMSHEET) Set e = Sheets(TOSHEET) Dim d Dim j Dim q d = 1 j = 2 e.Select Cells.Select Selection.Clear i.Select Rows(1).Copy e.Select Rows(1).PasteSpecial Do Until IsEmpty(i.Range("G" & j)) If i.Range(Column & j) = "Total" Then i.Select Rows(j).Copy e.Select Rows(2).PasteSpecial ' CopyValues i.Rows(j), e.Rows(2) Exit Do End If j = j + 1 Loop d = 2 j = 2 Do Until IsEmpty(i.Range("G" & j)) If i.Range(Column & j) = TOSHEET Or i.Range(Column & j) = EXTRA1 Or i.Range(Column & j) = EXTRA2 Or i.Range(Column & j) = EXTRA3 Then d = d + 1 CopyValues i.Range(i.Cells(j, 1), i.Cells(j, 11)), e.Range(e.Cells(d, 1), e.Cells(d, 11)) 'e.Range("A" & d) ElseIf i.Range("A" & j) = e.Range("A" & d) And i.Range("I" & j) = "Total" Then d = d + 1 e.Select Rows(2).Copy Rows(d).PasteSpecial ' CopyValues e.Rows(2), e.Rows(d) End If j = j + 1 Loop e.Select Rows(2).Delete Range("A1").Select End Function 所以，我有两个问题。 首先，我正确的说，移动到arrays会加快速度？ 其次，我该如何做arrays的东西？ 谢谢！ 这就是我正在攻击的东西，在那里的许多不同的尝试，我意识到这是丑陋的：
Private Function RESORT2(FROMSHEET As Variant, Column As Variant, TOSHEET As Variant, EXTRA1 As Variant, EXTRA2 As Variant, EXTRA3 As Variant) ' Set i = Sheets(FROMSHEET) ' Set e = Sheets(TOSHEET) Dim d Dim j As Long Dim i As Long Dim k As Long Dim myarray As Variant Dim arrTO As Variant d = 1 j = 1 'myarray = Worksheets(FROMSHEET).Range("a1").Resize(10, 20) myarray = Worksheets(FROMSHEET).Range("a1:z220").Value 'Resize(10, 20) For i = 1 To UBound(myarray) If myarray(i, 9) = TOSHEET Then 'arrTO = myarray ' Worksheets(TOSHEET).Range("A" & j).Resize(1, 20) = Application.WorksheetFunction.Transpose(myarray(i)) Worksheets(TOSHEET).Range("A" & j).Value = Application.WorksheetFunction.Transpose(myarray) ' arrTO = j 'Application.WorksheetFunction.Index(myarray, 0, 1) j = j + 1 End If Next Worksheets(TOSHEET).Range("a1").Resize(10, 20) = arrTO End Function
===================================
首先编辑
好吧，我试图清理和以下内容：
Private Function RESORT(FROMSHEET As Variant, Column As Variant, TOSHEET As Variant, EXTRA1 As Variant, EXTRA2 As Variant, EXTRA3 As Variant) Set FRO = Sheets(FROMSHEET) Set TOO = Sheets(TOSHEET) Dim TOO_IND Dim FRO_IND Dim TotalRow TotalRow = 2 TOO_IND = 2 FRO_IND = 2 TOO.Cells.Clear TOO.Rows(1).Value = FRO.Rows(1).Value Do Until IsEmpty(FRO.Range("G" & TotalRow)) If FRO.Range(Column & TotalRow) = "Total" Then FRO.Select Rows(TotalRow).Copy TOO.Select Rows(2).PasteSpecial ' CopyValues FRO.Rows(j), TOO.Rows(2) Exit Do End If TotalRow = TotalRow + 1 Loop Do Until IsEmpty(FRO.Range("G" & FRO_IND)) If FRO.Range(Column & FRO_IND) = TOSHEET Or FRO.Range(Column & FRO_IND) = EXTRA1 Or FRO.Range(Column & FRO_IND) = EXTRA2 Or FRO.Range(Column & FRO_IND) = EXTRA3 Then TOO_IND = TOO_IND + 1 TOO.Rows(TOO_IND).Value = FRO.Rows(FRO_IND).Value ElseIf FRO.Range("A" & FRO_IND) = TOO.Range("A" & TOO_IND) And FRO.Range("I" & FRO_IND) = "Total" Then TOO_IND = TOO_IND + 1 TOO.Select Rows(2).Copy Rows(TOO_IND).PasteSpecial ' TOO.Rows(TOO_IND).PasteSpecial = FRO.Rows(2).PasteSpecial ' this isn't working, I need format and formula, if I just do .formula it doesn't work End If FRO_IND = FRO_IND + 1 Loop TOO.Rows(2).Delete 'Range("A1").Select End Function
所以，虽然它看起来更干净，更具可读性，但它实际上是比较慢的（我最小的样本集为3.2s和2.86s）。
我认为arrays将是解决scheme。 我在同一个样本集上多次运行这个例程，但是使用不同的限定符，如果主要的话我把样本集转储到一个数组中，然后把这个数组传递给这个sorting例程，我认为它会更快。 但我仍然不确定如何对数组执行操作，特别是从数组到数组复制一行。
谢谢大家，我会继续努力！
================================================== ============
二编辑好吧，我现在更接近！ 曾经花了133秒，现在只需要10.51秒！
这是最新的，请让我知道如果有办法来调整这一点，我仍然在努力修剪一些时间。 我还没有编写任何代码来抓取数组，然后将数组传递给RESORT函数，我正在调查下，看看是否有助于加快速度。
有没有办法将公式和值复制到相同的数组？ 我不喜欢我这样做，但它确实有效。
Private Function RESORT(FROMSHEET As Variant, Column As Variant, TOSHEET As Variant, EXTRA1 As Variant, EXTRA2 As Variant, EXTRA3 As Variant) Set FRO = Sheets(FROMSHEET) Set TOO = Sheets(TOSHEET) Dim TotalRow TotalRow = 2 TOO_IND = 2 FRO_IND = 2 Dim Col As Long Dim FROM_Row As Long Dim TO_Row As Long Const NumCol = 25 Dim myarray As Variant Dim myarrayform As Variant Dim arrTO(1 To 1000, 1 To 2000) Dim arrTotal(1 To 1, 1 To NumCol) TO_Row = 2 myarray = Worksheets(FROMSHEET).Range("a1:z1000").Value myarrayform = Worksheets(FROMSHEET).Range("a1:z1000").FormulaR1C1 TOO.Cells.Clear For Col = 1 To NumCol arrTO(1, Col) = myarray(1, Col) Next For FROM_Row = 1 To UBound(myarray) If myarray(FROM_Row, Column) = "Total" Then For Col = 1 To NumCol arrTotal(1, Col) = myarrayform(FROM_Row, Col) Next Exit For End If Next For FROM_Row = 1 To UBound(myarray) If myarray(FROM_Row, Column) = TOSHEET Or myarray(FROM_Row, Column) = EXTRA1 Or myarray(FROM_Row, Column) = EXTRA2 Or myarray(FROM_Row, Column) = EXTRA3 Then For Col = 1 To NumCol arrTO(TO_Row, Col) = myarray(FROM_Row, Col) Next TO_Row = TO_Row + 1 ElseIf myarray(FROM_Row, 1) = arrTO(TO_Row - 1, 1) And myarray(FROM_Row, Column) = "Total" Then For Col = 1 To NumCol arrTO(TO_Row, Col) = arrTotal(1, Col) Next TO_Row = TO_Row + 1 End If Next Worksheets(TOSHEET).Range("a1").Resize(1000, 2000) = arrTO End Function
感谢您的帮助！ 新年快乐！
迭代VBA中的数组不一定比迭代第一个方法使用的集合对象更快。 这些集合可能被实现为链表，所以为了从头开始并遍历它们，它们将像数组一样快。
高层次的答案是你的sortingalgorithm通常比你特定的代码细节更重要。 也就是说，只要你的细节不会增加运行该algorithm的复杂性。
根据我的经验，加速VBA的最好方法是避开所有对UI有影响的函数。 如果你的代码在选中的单元格周围移动，或者切换活动查看表单等，那么这是最大的时间。 我认为这些函数Select ， Copy()和PasteSpecial()可能是有罪的。 最好存储工作表和范围对象，并根据需要直接写入单元格。 你在第二种方法中这样做，我认为这比改变你的数据types更重要。
我同意@Seth Battin，但有一些额外的东西要添加。
虽然数组可以更快，但是如果您需要search它们，则不能很好地扩展。 你所写的代码将遍历你的数据集n次（其中n是你拥有的TOSHEET的数量）。 另外，你的代码将数据写入工作表一次（这是耗时的），将所有数据放入一个2D数组并写入一次会更快（但代码更多）。
一个更好的程序stream程可能是
读取每一行数据
将其分配给数据结构（我将使用包含2D数组的脚本字典）
读完所有数据后，迭代输出每个二维数组的脚本字典
这将最大限度地减less对电子表格的读取和写入，这是这种types的VBA程序的性能瓶颈所在。
是。 你肯定会通过使用数组而不是单元的集合加速你的代码。 这是因为访问对象的属性需要时间。
老实说，你的代码很可能不会从使用数组中获益，因为通过消除不必要的循环，可以更合理地修改代码。
我已经以更加以Excel为中心的方式重写了RESORT函数的开头，避免了一些类似select的缺陷。 我也build议尝试使用有意义的variables名称，尤其是对象。
OPTION EXPLICIT Private Function RESORT(FROMSHEET As Variant, Column As Variant, TOSHEET As Variant, EXTRA1 As Variant, EXTRA2 As Variant, EXTRA3 As Variant) 'Actually indicate variable types. dim i as worksheet, dim e as worksheet dim searchRange as Range Set i = Sheets(FROMSHEET) Set e = Sheets(TOSHEET) Dim d as long Dim j as long dim lastRow as long 'Using a meaningful variable name d = 1 j = 2 'I'm assuming you were using PasteSpecial because you only want values. 'I removed your unnecessary selects e.Cells.Clear 'Move values directly instead of copy paste i.Rows(1).value = e.Rows(1).value 'Check the first range If Not IsEmpty(.Range("G" & j)) Then 'Determine the last row to check. 'This would break if j is equivalent to the last possible row... 'but only an example If IsEmpty(.Range("G" & j+1) then lastRow = j else lastrow = i.Range("G" & j).End(xlDown).Row end if 'Get the search Range 'We might have used arrays here but it's less complicated to ' use built in functions. Set searchRange = i.Range(i.Range(Column & j), _ i.Range(Column, lastrow).Find("Total")) If Not (searchRange Is Nothing) Then 'Copy the values of the found row. e.Rows(2).value = searchRange.EntireRow.value End If End If
这样做后，我意识到，可能更合理地使用数组的部分是在我停止的地方。 如果你想在这里使用数组，你需要做的就是有效地将所有的相关区域复制到一个数组中，然后像引用单元一样引用数组。
例如：
myArray = i.Range("A1:B10") MsgBox myArray(10, 2) 'Displays value of B10 (10th row, 2nd column) MsgBox i.Cells(10, 2) 'Displays value of B10 (10th row, 2nd column)