Question

VBA noob在这里，一直在寻找一个我可以根据自己的需求修改的脚本，但是仍然遇到困难或无法为我的具体情况做任何工作。

我正在尝试编写一个简单但特定的宏来查找范围内的重复项。

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

中

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

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

我可以在几秒钟内完成条件格式化，但我需要计算后面的彩色单元格，我找不到任何可以找到的VBA宏将让我计算有条件格式化的颜色，甚至在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

确实，解决方案是完美的。但只是为了澄清，计算条件格式化单元格的初始方法也可以从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

VBA宏以使用范围查找重复项

2 个答案: