VBA宏使用范围查找重复项

VBA宏使用范围查找重复项,vba,excel,Vba,Excel,VBA noob在这里,已经搜索了2天,以找到一个脚本,我可以修改我的需要,但不断陷入困境,或无法使任何工作为我的具体情况 我正在尝试编写一个简单但具体的宏,以查找和着色范围内的重复项 我的搜索条件在范围内(B5:B405) 要扫描和着色的数据位于范围内(D5:OM1004) 数据仅为数字,需要与搜索条件完全匹配,如果发现数据中的单元格存在于搜索条件中,则数据单元格填充为红色 我还需要在数据行1004处停止脚本,并在最后显示一条包含总执行时间的消息 我可以用条件格式在几秒钟内完成这项工作,但我需

VBA noob在这里,已经搜索了2天,以找到一个脚本,我可以修改我的需要,但不断陷入困境,或无法使任何工作为我的具体情况

我正在尝试编写一个简单但具体的宏,以查找和着色范围内的重复项

我的搜索条件在范围内(B5:B405) 要扫描和着色的数据位于范围内(D5:OM1004)

数据仅为数字,需要与搜索条件完全匹配,如果发现数据中的单元格存在于搜索条件中,则数据单元格填充为红色

我还需要在数据行1004处停止脚本,并在最后显示一条包含总执行时间的消息

我可以用条件格式在几秒钟内完成这项工作,但我需要计算之后的彩色单元格,而且我找不到任何VBA宏可以让我计算条件格式的颜色,即使我在cpearson的所有网站上都没有成功。

尝试以下方法:

Option Explicit
Sub ColorCriteria()
    Dim rCriteria As Range
    Dim rData As Range
    Dim c As Range, r As Range
    Dim sFirstAddress As String
    Dim ColorCounter As Long
    Dim StartTime As Single, EndTime As Single

StartTime = Timer
Set rCriteria = Range("B5:B405")
Set rData = Range("D5:OM1004")

Application.ScreenUpdating = False
With rData
    .Interior.ColorIndex = xlNone

For Each r In rCriteria
    If Not r = "" Then
    Set c = .Find(what:=r.Value, LookIn:=xlValues, lookat:=xlWhole, _
            searchdirection:=xlNext)
    If Not c Is Nothing Then
        sFirstAddress = c.Address
        c.Interior.Color = vbRed

        Do
            Set c = .FindNext(c)
            c.Interior.Color = vbRed
            ColorCounter = ColorCounter + 1
        Loop Until c.Address = sFirstAddress
    End If
    End If
Next r

End With
Application.ScreenUpdating = True
EndTime = Timer

MsgBox ("Execution Time: " & Format(EndTime - StartTime, "0.000"" sec""") _
    & vbLf & "Colored Cell Count: " & ColorCounter)


End Sub

事实上,解决方案是完美的。但为了澄清这一点,计算条件格式单元格的初始方法也可以从Excel 2010开始使用。 在那里可以识别颜色,然后用这样的方法计数细胞

Set aktSheet = Application.ActiveWorkbook.Worksheets("Sheet1")
counter = 0
For Each c In aktSheet.Range("D5:OM1004").Cells
    If c.DisplayFormat.Interior.ColorIndex = 38 Then
        counter = counter + 1
    End If
Next

数据样本和相关输出可能有助于我们为您提供关于如何进行的不同选项。您好,Sid,标准和数据仅由数字组成。例如,如果B5=1且D10、F5、OA100=1,则D10、F5和OA100将具有红色填充。我希望这能澄清一点?罗恩,你帮了我这么多。太感谢你了!完美A++另一个VBA noob,为了测试这个程序,我更改了设置rCriteria=Range(“A1:A10”)设置rData=Range(“B1:B20”),但现在收到一个运行时错误1004@pal4life你的评论中没有足够的信息让我帮助你解决这个问题。如果您正在寻求帮助以使代码正常工作,我建议您按照和中提到的指导原则发布一个问题。您应该注意,Range对象的DisplayFormat属性仅出现在Excel 2010中,因此您的解决方案在早期版本上不起作用。