我可以使这个宏/代码更快吗？ （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