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

Question

事先感谢任何有关此问题的帮助，我有一个很大的电子表格，我需要解析其他电子表格，我有一些工作，虽然很慢。我已经读过使用数组是一种更好的方法，但我似乎无法让它工作，我想我可以把主电子表格拉成一个数组，但我不能像我想的那样操作它。具体来说，我无法从主数组中获取某些行，并将它们插入到另一个数组中，以便最后复制到目标工作表中。以下是原始的工作函数：

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

所以，我有两个问题。首先，我是否正确，移动到阵列将加快这一点？其次，我该怎么做数组的东西？谢谢！这就是我正在攻击的东西，在那里做了很多不同的尝试，我发现它很难看：

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.2秒与2.86秒）。

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

谢谢大家，我会坚持下去！

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

第二次编辑好的，我现在离我更近了！曾经花了大约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

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

Answer 1

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

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

根据我的经验，加速VBA的最佳方法是避开所有对UI产生影响的功能。如果您的代码在所选单元格周围移动，或者切换活动查看的工作表等，那么这是最大的时间链接。我认为这些函数Select，Copy()和PasteSpecial()可能会犯这样的错误。最好存储工作表和范围对象，并根据需要直接写入其单元格。你在第二种方法中这样做，我认为它比改变你的数据类型更重要。

Answer 2

我同意@Seth Battin，但还有一些补充。

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

更好的计划流程可能是

阅读每一行数据

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

在读取所有数据之后，迭代输出每个2D数组的脚本字典

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

Answer 3

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

老实说，你的代码可能不会因使用数组而受益，因为通过消除不必要的循环可以更合理地修改代码。

我以更加以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

在这样做之后，我意识到可能更合理地使用数组的部分是在我停止的地方之后。如果你想在这里使用数组，你需要做的是有效地将所有相关区域复制到一个数组，然后引用数组，就像引用单元格一样。

例如：

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)

Excel VBA，使用数组加速代码

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

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

3 个答案: