检查整列的颜色

我试图创build一个if语句来检查B列的颜色。

它适用于如果我试图在B列中定位单个单元格（“B：B”）的情况。

这是我的。

Sub FOO() Dim answer As Range Set answer = Range("b:b") If answer.Interior.Color = vbRed Then MsgBox ("There is an issue with column B, please review.") End If End Sub 

Answer 1

正如我们正在获得许多质量的答案，这里是最优化的代码。 最快，我敢打赌:)

如果你使用的是古老的excel版本之一，它将无法正常工作。 什么2007+是好的。

 Sub OptimizedFOO() Dim rngTemp With Application.FindFormat.Interior .Color = vbRed End With '/ Sheet1 is example sheet name Set rngTemp = Sheet1.Columns(2).Find(What:="", SearchFormat:=True) If Not rngTemp Is Nothing Then MsgBox ("There is an issue with column B, please review.") End If End Sub 

---

老答案

 Sub FOO() Dim answer As Range Dim cell As Range '/ This will show message if at least one cell is found with red color Set answer = Range("b:b") For Each cell In answer.Cells If answer.Interior.Color = vbRed Then MsgBox ("There is an issue with column B, please review.") Exit For End If Next End Sub 

Answer 2

我不确定，但给你我最好的猜测。

如果VB统一了属性，那么它统一了列的所有单元格的属性。 然后，您可以将该属性与值进行比较，如果所有stream程都具有相同的值，则该值为True。 否则，比较将是False。

所以If answer.Interior.Color = vbRed将是True，如果所有单元格都有这个价值vbRed 。 如果要检查是否有任何单元格具有该颜色，则可能需要遍历所有单元格。

我相信VB和VB的对象模型是这样工作的，但是，我不确定。

Answer 3

我会find列B上最后使用的行，并通过它们循环。

 Sub FOO() Dim LR As Long, I As Long LR = findLastRow("Sheet1", "B") For I = 1 To LR If Range("B" & I).Interior.Color = vbRed Then MsgBox ("There is an issue with column B, please review.") Exit For End If Next I End Sub Function findLastRow(shtName As String, colLetter As String) As Long With Sheets(shtName) If Application.WorksheetFunction.CountA(.Cells) <> 0 Then findLastRow = .Cells.Find(What:="*", _ After:=.Range(colLetter & "1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row Else findLastRow = 1 End If End With End Function 

Answer 4

你可以用自动filter来做一些事情，就像这样

 Function AnyRedCells(rngRangeToInspect As Excel.Range) As Boolean Application.ScreenUpdating = False rngRangeToInspect.AutoFilter rngRangeToInspect.AutoFilter field:=1, Criteria1:=RGB(255, 0, 0), Operator:=xlFilterCellColor ' Using >1 as assuming header on column AnyRedCells = (ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Cells.Count > 1) rngRangeToInspect.AutoFilter Application.ScreenUpdating = True End Function 

像这样使用

 Sub OptimizedFOO2() If AnyRedCells(Range("b23:b26")) Then MsgBox ("There is an issue with column B, please review.") End If End Sub