检查列中的重复项并突出显示它

Question

我需要检查 column B 中的重复项，我编写了以下代码，看起来没问题，但我得到了 Run time Error 13 type-mismatch 请帮忙。为什么我会得到它？

Sub duplicate()
    Dim myRange As Range
    Dim myCell As Range

    Set myRange = Columns("B:B")
    For Each myCell In myRange
        If WorksheetFunction.CountIf(myRange, myCell.Value) > 1 Then ' Run-time error 13 Type mismatch
            myCell.Interior.ColorIndex = 3
        End If
    Next myCell
End Sub

更新： 更多信息请关注https://www.youtube.com/watch?v=drZK_-zzo_4

Answer 1

您不需要 VBA 来为副本着色。只需使用条件格式：

但只是为了您的兴趣，导致代码错误的原因是，如果您循环

For Each myCell In myRange

您实际上并没有遍历myRange 中的单元格，而是遍历myRange 的列，这只是一个（B 列）。如果要循环遍历myRange 的单元格，则需要将其更改为

For Each myCell In myRange.Cells

否则 myCell.Value 是 B 列值的数组，因此 WorksheetFunction.CountIf(myRange, myCell.Value) 失败。

---

如果您确实必须使用 VBA，我强烈建议您使用 VBA 而不是您的代码来创建条件格式。这会快得多，您的代码非常慢。

Option Explicit

Public Sub CreateRuleForDuplicates()
    Dim MyRange As Range
    Set MyRange = Columns("B:B")
    With MyRange
        .FormatConditions.AddUniqueValues
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        .FormatConditions(1).DupeUnique = xlDuplicate
        .FormatConditions(1).Interior.ColorIndex = 3
        .FormatConditions(1).StopIfTrue = False
    End With
End Sub

请注意，如果您多次运行该代码，它每次都会添加一个new 规则。因此，您可能希望在添加新规则 .AddUniqueValues 之前删除该范围内的所有旧规则 .FormatConditions.Delete。