如何加快比较宏？

我想要一些提示来更快地运行此宏。我有一个很长的数据范围，它需要很长的时间。你们有没有想法加快速度？如何加快比较宏？

Sub GanadoAcumulado() 
    With ActiveSheet 
     LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row 
    End With 

    Tganhado = 0: Tjogado = 0 

    For i = 1 To LastRow 
     If Range("R1").Offset(i, 0).Value = "" Then 
      a = Range("A1").Offset(i, 0).Value 
      b = Range("B1").Offset(i, 0).Value 
      c = Range("C1").Offset(i, 0).Value 

      For j = 1 To LastRow 
       If Range("A1").Offset(j, 0).Value = a And _ 
       Range("B1").Offset(j, 0).Value = b And _ 
       Range("C1").Offset(j, 0).Value = c Then 
        Tjogado = Tjogado + Range("J1").Offset(j, 0).Value 
        Tganhado = Tganhado + Range("P1").Offset(j, 0).Value 
        Range("R1").Offset(j, 0).Value = Tganhado 
        Range("S1").Offset(j, 0).Value = Tjogado 
       End If 
      Next j 
     End If 
     Tganhado = 0 
     Tjogado = 0 
    Next i 
End Sub

来源

2013-04-26 karips

您可以通过不循环大幅提高性能通过范围内的单元格，但实际上将它们存储在一个数组中，然后循环该数组。 – 2013-04-26 21:34:52

这通常需要多长时间，您经历了多少行？ – glh 2013-04-26 21:35:58

'application.screenupdating = false'和'application.calculation = xlCalculateManual'在开始时会有所帮助。 – glh 2013-04-26 21:38:45

由于希德说一个数组的比较是性能更好，我已经做了我所能，以保持它，你在你的问题有：

Sub GanadoAcumulado() 
    With ActiveSheet 
     lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row 
    End With 

    'save range into arrays 
    Dim a As Variant, b As Variant, c As Variant 
    Dim j As Variant, p As Variant, r As Variant, s As Variant 
    a = ActiveSheet.Range("A1").Resize(lastrow) 
    b = ActiveSheet.Range("B1").Resize(lastrow) 
    c = ActiveSheet.Range("C1").Resize(lastrow) 
    j = ActiveSheet.Range("J1").Resize(lastrow) 
    p = ActiveSheet.Range("P1").Resize(lastrow) 
    r = ActiveSheet.Range("R1").Resize(lastrow) 
    s = ActiveSheet.Range("S1").Resize(lastrow) 

    'join columns a,b,c to ease of searching 
    Dim abc As Variant 
    ReDim abc(1 To UBound(a, 1), 1 To 1) 
    For i = 1 To lastrow 
     abc(i, 1) = a(i, 1) & b(i, 1) & c(i, 1) 
    Next 
    Erase a, b, c 

    For x = 1 To lastrow 
     Tganhado = 0 
     Tjogado = 0 

     If r(x, 1) = "" Then 

      For y = 1 To lastrow 
       If abc(y, 1) = abc(y, 1) Then 
        Tjogado = Tjogado + j(y, 1) 
        Tganhado = Tganhado + p(y, 1) 
        r(y, 1) = Tganhado 
        s(y, 1) = Tjogado 
       End If 
      Next 
     End If 
    Next 

    ActiveSheet.Range("R1").Resize(lastrow) = r 
    ActiveSheet.Range("S1").Resize(lastrow) = s 

    Erase abc, j, p, r, s 
End Sub

来源

2013-04-28 09:36:10 glh

如何加快比较宏？

回答

相关问题