Excel VBA，使用数组加速代码

Excel VBA, speed up code with arrays

提问by user1938351

thanks in advance for any help on this, I have a big spreadsheet I need to parse into other spreadsheets, and I have something working, albeit slowly. I've read that using arrays is a better approach, but I can't seem to get it working, I think I can pull the main spreadsheet into an array, but I can't operate on it like I want. Specifically, I can't grab certain rows from the main array and insert them into another array to copy into a target sheet at the end. Here are the original, working functions:

提前感谢您对此的任何帮助，我有一个很大的电子表格，我需要将其解析为其他电子表格，并且我有一些工作，尽管速度很慢。我读过使用数组是一种更好的方法，但我似乎无法让它工作，我想我可以将主电子表格拉入一个数组，但我不能像我想要的那样对其进行操作。具体来说，我无法从主数组中获取某些行并将它们插入另一个数组中以在最后复制到目标表中。以下是原始的工作功能：

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

So, I have two questions. First, am I correct that moving to arrays will speed this up? Second, how do I do the array stuff? Thanks! Here's sort of what I'm hacking on, many different attempts in there, I realize it's ugly:

所以，我有两个问题。首先，我是否正确地认为移动到数组会加快速度？其次，我如何做数组的东西？谢谢！这是我正在攻击的内容，在那里进行了许多不同的尝试，我意识到这很丑陋：

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

===================================

====================================

First Edit

首先编辑

OK, i tried cleaning up and a the following:

好的，我尝试清理并执行以下操作：

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

So, while it looks cleaner and is more readable, it's actually slower (3.2s vs. 2.86s on my smallest sample set).

因此，虽然它看起来更干净且更具可读性，但它实际上更慢（在我最小的样本集上为 3.2 秒与 2.86 秒）。

I think the array is going to be the solution. I run this routine multiple times on the same sample set, but with different qualifiers, if in the main I dump the sample set into an array, then pass this array to this sort routine, I think it'll be faster. But I'm still not sure how to do my operations on arrays, specifically copying one row from array to array.

我认为阵列将成为解决方案。我在同一个样本集上多次运行这个例程，但使用不同的限定符，如果在主要我将样本集转储到一个数组中，然后将此数组传递给这个排序例程，我认为它会更快。但是我仍然不确定如何对数组进行操作，特别是将一行从数组复制到数组。

Thanks everyone, I'm going to keep at it!

谢谢大家，我会坚持的！

==============================================================

================================================== ============

Second Edit Ok, I'm much closer now! What once took ~133seconds, now only takes 10.51seconds!

第二次编辑好的，我现在更接近了！曾经需要大约 133 秒的时间，现在只需要 10.51 秒！

Here's the latest, please let me know if there are ways to tweak this, I'm still trying to trim up some time. I have not yet coded anything to grab the array once and then pass the array to the RESORT function, I'm looking into that next to see if that will help speed things up.

这是最新的，如果有办法调整这个，请告诉我，我仍在尝试修剪一些时间。我还没有编写任何代码来一次性抓取数组，然后将数组传递给 RESORT 函数，我正在研究接下来的内容，看看这是否有助于加快速度。

Is there a way to copy the formula and the value into the same array? I don't like the way I do it, but it does work.

有没有办法将公式和值复制到同一个数组中？我不喜欢我这样做的方式，但它确实有效。

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

Thanks for any and all help! Happy New Year!

感谢您的任何帮助！新年快乐！

回答by Seth Battin

Iterating over arrays in VBA will not necessarily be faster than iterating over the collection objects that your first method uses. The collections are likely implemented as linked lists, so for the purpose of starting at the beginning and looping over them, they will be equally as speedy as arrays.

在 VBA 中迭代数组不一定比迭代第一个方法使用的集合对象快。集合可能被实现为链表，因此为了从头开始并循环遍历它们，它们将与数组一样快。

The high-level answer is that your sort algorithm will usuallybe vastly more important than your specific code details. That is, as long as your details don't somehow increase the complexity of running that algorithm.

高层次的答案是，您的排序算法通常比您的特定代码细节重要得多。也就是说，只要您的详细信息不会以某种方式增加运行该算法的复杂性。

In my experience, the best way to speed up VBA is to eschew all functions that have an effect on the UI. If your code moves around the selected cell, or switches the actively viewed sheet, etc, that is the biggest timesink. I think those functions Select, Copy(), and PasteSpecial()might be guilty of that. It would be better to store worksheet and range objects, and write directly to their cells as required. You do that in your 2nd method, and I think it is much more important than changing your data type.

根据我的经验，加速 VBA 的最好方法是避开所有对 UI 有影响的函数。如果您的代码在所选单元格周围移动，或切换当前查看的工作表等，这就是最大的时间点。我认为这些函数Select,Copy()和PasteSpecial()可能会犯这种错误。最好存储工作表和范围对象，并根据需要直接写入它们的单元格。您在第二种方法中执行此操作，我认为这比更改数据类型重要得多。

回答by Pynner

I agree with @Seth Battin, but have a few additional things to add.

我同意@Seth Battin，但还有一些额外的东西要补充。

While arrays can be faster, if you need to search them they do not scale well. The code you have written will iterate through your dataset n times (where n is the number of TOSHEETs you have). Also your code is writing data to the worksheet once for each row (which is time consuming), It is faster (but more code) to put all the data into a single 2D array and write once.

虽然数组可以更快，但如果您需要搜索它们，它们就不能很好地扩展。您编写的代码将遍历您的数据集 n 次（其中 n 是TOSHEET您拥有的s的数量）。此外，您的代码为每一行将数据写入工作表一次（这很耗时），将所有数据放入单个二维数组并写入一次会更快（但代码更多）。

A better program flow might be

更好的程序流程可能是

Read each line of data

读取每一行数据

Assign it to a data structure (I would use a scripting dictionary containing 2D arrays)

将其分配给数据结构（我将使用包含二维数组的脚本字典）

After all the data is read iterate the scripting dictionary outputting each 2D array

读取所有数据后，迭代输出每个二维数组的脚本字典

This will minimize both reads and writes to the spreadsheet which is where the preformance bottlenecks are for this type of vba program.

这将最大限度地减少对电子表格的读取和写入，这是此类 vba 程序的性能瓶颈所在。

回答by Daniel

Yes. You would definitely speed up your code by using arrays instead of collections of cells. This is because accessing the properties of the objects takes time.

是的。您肯定会通过使用数组而不是单元格集合来加速您的代码。这是因为访问对象的属性需要时间。

Honestly though, your code would likely not benefit very much from using arrays as your code is more reasonably modified by eliminating unnecessary loops.

老实说，您的代码可能不会从使用数组中受益很多，因为您的代码通过消除不必要的循环而得到更合理的修改。

I've re-written the beginning of your RESORT function in a more Excel centric way avoiding some of the pitfalls like selects. I'd also suggest trying to use variable names that are meaningful, especially for objects.

我已经以一种更加以 Excel 为中心的方式重写了 RESORT 函数的开头，避免了选择等一些陷阱。我还建议尝试使用有意义的变量名称，尤其是对于对象。

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

After doing that I realize that the part that might more reasonably use arrays is after where I stopped. If you want to use arrays here, what you need to do is effectively copy all of the relevant area to an array and then reference the array the same way that you would reference cells.

这样做之后，我意识到可能更合理地使用数组的部分是在我停下来的地方之后。如果您想在这里使用数组，您需要做的是有效地将所有相关区域复制到一个数组中，然后以与引用单元格相同的方式引用该数组。

For Example:

例如：

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)