工作表变更：计数突出显示的单元格

• 请注意，这是一个很大的范围，如果删除条件 “如果范围第一列的值为空，则不应计算该行”，代码将花费大约5秒（在A列中的每个更改上）。如果列A中的所有单元格都被填充。
• 我认为这一切都是XY problem。要走的路将是实现逻辑，你已经使用了条件格式摆在首位，到VBA。但这需要更多的信息。

Option Explicit

' The worksheet name ("ADIS") is irrelevant. Use the 'Me' keyword instead.
' Whenever you change a value in the 1st column of the range,
' this code runs automatically counting the colors in the remaining columns.
' It is assumed that blank cells in the first column will have no highlights
' in the remaining columns.
Private Sub Worksheet_Change(ByVal Target As Range)
     
    Const SHOW_MESSAGE_BOX As Boolean = True
    Dim Success As Boolean
    On Error GoTo ClearError

    Const SOURCE_RANGE As String = "A3:DD2500"

    Dim Blue As Long: Blue = RGB(155, 194, 230)
    Dim Green As Long: Green = RGB(169, 208, 142)
    Dim Yellow As Long: Yellow = RGB(255, 255, 0)
    
    Dim trg As Range, CountRange As Range

    With Me.Range(SOURCE_RANGE)
        Set trg = .Columns(1)
        ' If a change didn't happen in the first column, do nothing.
        If Intersect(trg, Target) Is Nothing Then Exit Sub
        Set CountRange = .Resize(, .Columns.Count - 1).Offset(, 1)
    End With
    
    Dim CountRangeRow As Range, CountRangeCell As Range, r As Long
    Dim BlueCount As Long, GreenCount As Long
    Dim YellowCount As Long, YellowTextCount As Long
    
    For Each CountRangeRow In CountRange.Rows
        r = r + 1
        If Len(trg.Cells(r)) > 0 Then
            For Each CountRangeCell In CountRangeRow.Cells
                Select Case CountRangeCell.DisplayFormat.Interior.Color
                    Case Blue
                        BlueCount = BlueCount + 1
                    Case Green
                        GreenCount = GreenCount + 1
                    Case Yellow
                        If Len(CStr(CountRangeCell.Value)) = 0 Then ' is blank
                            YellowCount = YellowCount + 1
                        Else ' is not blank
                            YellowTextCount = YellowTextCount + 1
                        End If
                    'Case Else ' neither; do nothing
                End Select
            Next CountRangeCell
        End If
    Next CountRangeRow
    
    ' Before writing to the worksheet, disable events or the code
    ' gets triggered again and again until Excel crashes!
    Application.EnableEvents = False
    
    With Me
        .Range("C2504").Value = YellowCount
        .Range("D2504").Value = BlueCount
        .Range("E2504").Value = GreenCount
        .Range("F2504").Value = YellowTextCount
    End With

    Success = True

ProcExit:
    On Error Resume Next
        ' Don't forget to enable events again!
        If Not Application.EnableEvents Then Application.EnableEvents = True
        If SHOW_MESSAGE_BOX Then
            If Success Then MsgBox "Highlighted cells counted.", vbInformation
        End If
    On Error GoTo 0
    Exit Sub
ClearError:
    MsgBox "Run-time error '" & Err.Number & "':" & vbLf & vbLf _
         & Err.Description, vbCritical
    Resume ProcExit
End Sub