在表格中逐行“直到”直到在VBA中找到第一个彩色单元格？

Question

我有一个 7 列的 excel 表格，用户可以放置他们的输入。放置输入后，他们有一个验证宏要运行，它将具有无效值的单元格着色为红色。我想在使用 VBA 宏着色后创建一个关于这些错误的摘要表，但前提是表中有任何彩色单元格。 如果表格范围内的某处至少有一个红色单元格，则应创建此摘要表，否则应弹出一个 MsgBox，告知没有错误。我想创建最简单的方法来做到这一点，如下所示： 问题是我收到了“发现验证错误，请检查错误表”消息，即使我没有红色单元格。

Sub errorListCreation(Sheet1 As Worksheet)
Dim isColored As Boolean
isColored = False
    For Each Acell In Sheet1.Range("A2", Range("K" & Sheet1.usedRange.Rows.Count))
        With Acell
            If Acell.DisplayFormat.Interior.Color = RGB(255, 0, 0) Then
                isColored = True
                Exit For
            End If
        End With
    Next Acell

    If isColored = True Then
        MsgBox "Validation errors found, please check the Errors sheet. "
        For Each errorList In Worksheets
            If errorList.Name = "Errors" Then
                Application.DisplayAlerts = False
                Sheets("Errors").Delete
                Application.DisplayAlerts = True
            End If
        Next
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Errors"
    Else: MsgBox "Validation complete, please check the reconciliation sheet."
    End If
End Sub

Answer 1

我建议这样：

Option Explicit

Public Function IsColored(ByVal Rng As Range) As Boolean
    IsColored = (Rng.Interior.Color = RGB(255, 0, 0))
End Function

Public Sub ColorFinder(ByVal ws As Worksheet)
    Dim ErrorFound As Boolean

    Dim InputTable As ListObject
    Set InputTable = ws.ListObjects("Table4") 'probably no good idea to hard code the table name (at least use a meaningful name)

    With InputTable.DataBodyRange
        Dim iRow As Long, iCol As Long
        For iRow = .Rows.Count To 1 Step -1
            For iCol = .Columns.Count To 1 Step -1
                If IsColored(.Cells(iRow, iCol)) Then
                    ErrorFound = True
                    Exit For
                End If
            Next iCol
            If ErrorFound Then Exit For
        Next iRow
    End With

    If ErrorFound Then
        MsgBox "Errors found", vbCritical
    Else
        MsgBox "No errors found", vbInformation
    End If
End Sub

Sub test()
    ColorFinder Worksheets("Sheet1")
End Sub

在下一张纸上

^{图 1：假设上面的工作表“Sheet1”带有一个 ListObject“Table4”。}

你会得到

“发现错误”