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

我使用下面的代码突出显示两个具有重复条目的列

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

这两列有“单独的”重复项，因为只有当mat和bat值匹配时，我才查找。我可以用编程的方式查找这个特定的条件，但至少可以说我的VBA很差

该区域有1000行，一次应该检查一列。该宏大约需要40秒来高亮显示每一列。这是预期的时间吗？我能把它做得更快而不太复杂吗？我可能需要将搜索范围扩大到10000行

下面是示例数据

---

每个重复检查循环的顶部都有不必要的循环。这必然会降低代码的速度

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

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

---

不能使用条件格式|突出显示单元格规则|重复值…？这可能有效，是的。我去看看。我确实打算将其扩展到只突出显示如上所述的“关键”副本，并且我认为这只有在VBA中才可能。。。因此，将此作为起点似乎是有意义的。是的，我可以通过条件格式实现与上面相同的结果，谢谢。它没有回答这个问题，但是非常感谢您提供这个解决方案！如果您仍然需要慢代码的答案，请阅读下面的“我的回答”。@Stese VBA中还有其他途径，例如使用字典或集合对象。很高兴知道它对你有用。