VBAmacros使用范围查找重复项

VBA noob在这里，一直在寻找2天find一个脚本，我可以修改我的需求，但一直卡住或无法为我的具体情况做任何工作。

我试图写一个简单但特定的macros来查找和颜色范围内的重复。

我的search条件在范围（B5：B405）中要扫描和着色的数据位于范围（D5：OM1004）

数据只是数字，需要与search条件完全匹配，如果发现数据中的单元格存在于search条件中，则数据单元格被填充为红色。

我还需要停止数据行1004处的脚本，并在最后显示总执行时间的消息。

我可以用条件格式在几秒钟内做到这一点，但我需要计数后的彩色单元格，没有VBAmacros，我可以find将让我计算有条件格式的颜色，甚至通过所有的cpearson的网站没有成功。

Answer 1

尝试这个：

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 

Answer 2

事实上解决scheme是完美的。 但是，为了澄清一下，计算条件格式化单元格的最初方法也可以从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