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)

Excel - 极慢的循环宏

1 个答案: