performance - VBA代码运行两个循环非常慢

Question

我有这段代码，它依次运行两个循环。对于几千行来说它工作得很好。但随着行数的增加，代码的运行时间会明显延长。它应该循环超过 100.000 行，但这将花费数小时。 如果您发现此代码花费如此长时间的原因，请告诉我

Sub BSIS()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


Dim lngRow As Long
Dim counter As Long

       'Merge rows with duplicate Cells

With ActiveSheet

.Cells(1).CurrentRegion.Sort key1:=.Cells(1), Header:=xlYes 'change this to xlYes if your table has header cells

  For lngRow = ActiveSheet.UsedRange.Rows.Count To 2 Step -1

    If ActiveSheet.Cells(lngRow - 1, 1) = ActiveSheet.Cells(lngRow, 1) Then
        .Cells(lngRow - 1, 4) = .Cells(lngRow - 1, 4) + .Cells(lngRow, 4)
        .Rows(lngRow).Delete
    End If
  Next lngRow

End With

        'Delete rows with negative cells


With ActiveSheet

  For counter = ActiveSheet.UsedRange.Rows.Count To 1 Step -1

     If ActiveSheet.Cells(counter, 4) <= 0 Then
        .Rows(counter).Delete
     End If

  Next counter

End With

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

Answer 1

一个选项是将要检查的数据范围复制到数组中。使用该数组执行您想要的任何数据处理，然后将结果复制回 Excel 工作表中。这是一个例子:

Dim i As Integer
Dim j As Integer
Dim flagMatch As Boolean
Dim arrData2Search As Variant


Set arrData2Search = Range(Cells(1, 1), Cells(1000, 2000)).value

flagMatch = False
For j = 1 To 1000
    For i = 1 To 2000
        If arrData2Search (i, j)= "Target" Then
             flagMatch = True
        End If
    Next i
Next j