Excel VBA循环以比较多个值

Excel VBA循环以比较多个值,excel,loops,vba,Excel,Loops,Vba,我创建了一个嵌套for循环,用于比较两张图纸中的3个不同单元格值。当数据很小时,循环可以正常工作,但当我在5000行上运行时,它的速度太慢,导致excel崩溃。你知道如何更有效地运行它吗 Sub RowMatch() Dim x As Integer ' Make sure we are in the right sheet Worksheets("Q416").Activate ' Set numrows = number of rows of

我创建了一个嵌套for循环,用于比较两张图纸中的3个不同单元格值。当数据很小时,循环可以正常工作,但当我在5000行上运行时,它的速度太慢,导致excel崩溃。你知道如何更有效地运行它吗

    Sub RowMatch()

Dim x As Integer

      ' Make sure we are in the right sheet
      Worksheets("Q416").Activate
      ' Set numrows = number of rows of data.
      NumRows = Range("C2", Range("C2").End(xlDown)).Rows.count
      ' find the reference range
      Worksheets("Q415").Activate
      NumRows2 = Range("C5", Range("C5").End(xlDown)).Rows.count
      Worksheets("Q416").Activate
      MsgBox ("Total # of Rows on this sheet = " & NumRows & " and " & NumRows2 & " in Ref Range")
      Range("A1").Select
      ' Establish "For" loop to loop "numrows" number of times.
      For x = 1 To NumRows
        'MsgBox NumRows2
        For y = 1 To NumRows2
        'MsgBox (ActiveCell.Offset(x, 0).Value & " & " & Worksheets("Q415").Cells(y + 1, 1))
        If ActiveCell.Offset(x, 0).Value = Worksheets("Q415").Cells(y + 1, 1).Value _
        And ActiveCell.Offset(x, 2).Value = Worksheets("Q415").Cells(y + 1, 3).Value Then
        If ActiveCell.Offset(x, 5).Value = Worksheets("Q415").Cells(y + 1, 6).Value Then
        'If NumRows(i).Value = ActiveCell.Offset(1, 0).Value Then
        ActiveCell.Offset(x, 10).Value = "Same"
        Else
        ActiveCell.Offset(x, 10).Value = ActiveCell.Offset(x, 5).Value - Worksheets("Q415").Cells(y + 1, 6).Value
        End If
        End If


        Next y
        Next x
End Sub

在Excel VBA中读取和写入单元格是最慢的操作之一。相反,您应该将工作表中包含的值放入数组中,并在其中使用它们,这里有一个很好的参考:。使用NumRows变量和列字母或数字来定义组成数组的范围,例如:

myRange = Range("A1:C" & NumRows)
myArray = myRange.value
从Chip Pearson网站的链接:

Dim Arr() As Variant
Arr = Range("A1:B10")
Dim R As Long
Dim C As Long
For R = 1 To UBound(Arr, 1) ' First array dimension is rows.
    For C = 1 To UBound(Arr, 2) ' Second array dimension is columns.
        Debug.Print Arr(R, C)
    Next C
Next R

活细胞死亡!是的,快速搜索如何避免使用Select/Activate/activecell您可以尝试.find方法,并为第二个匹配匹配找到的每一行的另一列。看看我猜@CallumDA所指的帖子如下: