Question

我想要一些提示来更快地运行此宏。我有大量的数据，需要很长时间。你们中的任何人都有想加快速度吗？

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

Answer 1

正如Sid所说，阵列比较对于性能更好，我已尽我所能保持你的问题：

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

如何加快比较宏？

1 个答案: