使用范围查找重复项的 VBA 宏
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/20449028/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
VBA Macro to find Duplicates using Ranges
提问by VBA-Noob
VBA noob here, been searching for 2 days to find a script i can modify for my needs but keep getting stuck or not be able to make anything work for my specific situation.
这里的 VBA 菜鸟，已经搜索了 2 天以找到一个脚本，我可以根据自己的需要进行修改，但一直卡住或无法针对我的特定情况进行任何操作。
I'm trying to write a simple but specific macro to find and color duplicates in ranges.
我正在尝试编写一个简单但特定的宏来查找范围内的重复项并为其着色。
My search criteria is in Range(B5:B405) Data to be scanned and colored is located in Range(D5:OM1004)
我的搜索条件在 Range(B5:B405) 中要扫描和着色的数据位于 Range(D5:OM1004)
The data is only numbers and needs to be an exact match to the search criteria, if cell in data is found to exist in search criteria then data cell is filled red.
数据只是数字，需要与搜索条件完全匹配，如果发现数据中的单元格存在于搜索条件中，则数据单元格填充为红色。
I also need to stop the script at data row 1004 and display a message with total execution time at the end.
我还需要在数据行 1004 处停止脚本并在最后显示一条包含总执行时间的消息。
I can do this in seconds with Conditional Formatting but I need to count the colored cells after and no VBA Macros i can find will let me count conditionally formatted colors, even been through all of cpearson's site without success.
我可以使用条件格式在几秒钟内完成此操作，但是我需要计算之后的彩色单元格，并且我找不到任何 VBA 宏可以让我计算条件格式的颜色，甚至在没有成功的情况下浏览了 cpearson 的所有站点。
回答by Ron Rosenfeld
Try this:
尝试这个：
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
回答by Graffl
Indeed the solution is perfect. But just to clarify, that also the initial approach with counting conditional formated cells could work starting with Excel 2010. There the color can be identified and then the cells counted with something like this
事实上，解决方案是完美的。但只是为了澄清，计数条件格式化单元格的初始方法也可以从 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
