Excel - 极慢的循环宏

Question

Sub listClean()

For Each cellA In Range("A:A")

    If cellA.Value <> "" Then

        For Each cellB In Range("B:B")

            If cellB.Value <> "" Then

                If StrComp(cellA.Value, cellB.Value) = 0 Then

                    cellA.Value = ""

                End If

            End If

        Next

    End If

Next

MsgBox "Macro Finished"

End Sub

代码基本上从范围 A:A 中删除范围 B:B 中的任何内容。 我能做些什么来加快这个宏的速度吗？我在想 VBA 可以有办法将范围变成数组，然后清理数组。

Answer 1

这应该很快。

它使用数组而不是循环遍历范围。

Sub listClean()

Dim i As Long, t As Long, mtch As Long
Dim aClm() As Variant, bClm() As Variant
Dim outArr() As Variant

ReDim outArr(1 To 1) As Variant

With ActiveSheet
    'Load the arrays
    aClm = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Value
    bClm = .Range(.Cells(1, 2), .Cells(.Rows.Count, 2).End(xlUp)).Value
    t = 0
    For i = 1 To UBound(aClm, 1)
        mtch = 0
        'Search for match. If no match found it will error and stay at 0
        On Error Resume Next
            mtch = Application.WorksheetFunction.Match(aClm(i, 1), bClm, 0)
        On Error GoTo 0
        'Test whether match was found.
        If mtch = 0 Then
            t = t + 1
            'make output array bigger.
            ReDim Preserve outArr(1 To t) As Variant
            'Load value into last spot in output array
            outArr(t) = aClm(i, 1)
        End If

    Next i
    'Assign values to range from array.
    .Range("C1").Resize(UBound(outArr, 1), 1).Value = Application.Transpose(outArr)
End With


MsgBox "Macro Finished"

End Sub

它确实把输出放在 C 列。如果你想把它放在 A 列然后改变，

.Range("C1").Resize(UBound(outArr, 1), 1).Value = Application.Transpose(outArr)

到：

.Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).ClearContents
.Range("A1").Resize(UBound(outArr, 1), 1).Value = Application.Transpose(outArr)