Excel – 极慢的循环macros

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中删除：无论在范围B：B中。 有什么我可以做的，以加快这个macros？ 我在想VBA可以有一种方法来创build数组，然后清理数组。

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)