我可以让这个宏/代码更快吗？ （Excel VBA 重复查找器）

Question

我正在使用以下代码突出显示具有重复条目的两列。

Sub ChkDup()
'Declare All Variables
Dim myCell As Range
Dim matRow As Integer
Dim batRow As Integer
Dim matRange As Range
Dim batRange As Range
Dim m As Integer
Dim b As Integer

'set rows as we know them
matRow = 1000
batRow = 1000

'Loop each column to check duplicate values & highlight them.
For m = 3 To matRow
Set matRange = Range("A3:A1000")

'Loop, and highlight all matching materials
For Each myCell In matRange
If WorksheetFunction.CountIf(matRange, myCell.Value) > 1 Then
myCell.Interior.ColorIndex = 3
End If
Next
Next

'Loop again for batches
For b = 3 To batRow
Set batRange = Range("B3:B1000")
For Each myCell In batRange
If WorksheetFunction.CountIf(batRange, myCell.Value) > 1 Then
myCell.Interior.ColorIndex = 6
End If
Next
Next

End Sub

这两列有“单独的”重复项，因为只有当垫子和蝙蝠值与我正在寻找的匹配时。我可以以编程方式查找这个特定条件，但至少可以说我的 VBA 很差。

该区域有 1000 行，它应该一次检查一列。宏需要大约 40 秒来突出显示每一列。这是预期的时间吗？我可以在不让它变得太复杂的情况下让它更快吗？我可能需要将搜索扩展到 10000 行。

这是示例数据。

Answer 1

每个重复检查循环的顶部都有不必要的循环。这势必会减慢您的代码速度。

我已经编辑了您的代码。它应该运行得更快并给出相同的结果！

Sub ChkDupRevised()
    'Declare All Variables
    Dim myCell As Range
    Dim chkRow As Long
    Dim chkRange As Range

    'set rows as we know them
    chkRow = 1000

    'check column A
    Set chkRange = Range("A3:A" & chkRow)
    For Each myCell In chkRange
        If WorksheetFunction.CountIf(chkRange, myCell.Value) > 1 Then
            myCell.Interior.ColorIndex = 3
        End If
    Next

    'check column B
    Set chkRange = Range("B3:B" & chkRow)
    For Each myCell In chkRange
        If WorksheetFunction.CountIf(chkRange, myCell.Value) > 1 Then
            myCell.Interior.ColorIndex = 6
        End If
    Next

End Sub