循环遍历范围内的所有字体颜色单元格

Question

我根据标准提取数据并将它们标记为蓝色。我正在寻找一个宏的帮助，它会遍历一个范围内的所有字体颜色单元格（蓝色）。

我只想在一个范围内使用字体颜色的单元格并用不同的颜色标记。并且Msgbox显示符合条件的数据。

我很难找到有关循环遍历仅包含指定颜色的单元格的信息。有谁知道这是怎么做到的？

Dim i As Long
Dim LastRow As Integer 
LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Msg = "Data:"
For i = 1 To LastRow
  If Cells(i + 1, 2).Value - Cells(i, 2).Value <> 0 Then
    Cells(i, 2).Font.Color = vbBlue
    Cells(i, 1).Font.Color = vbBlue

    For Each Cell In Range("A:B")
      If Cells(i, 1).Font.Color = vbBlue And Cells(i + 1, 1).Value - Cells(i, 1).Value > 4 Then
        Cells(i, 2).Font.Color = vbGreen
        Cells(i, 1).Font.Color = vbGreen
      End If
    Next
    Msg = Msg & Chr(10) & i & " ) " & Cells(i, 2).Value & "    : " & "  -->  " & Cells(i, 1).Value
  End If
Next i
MsgBox Msg, vbInformation

Answer 1

我相信你应该可以使用 Find 功能来做到这一点......

例如，选择工作表上的一些单元格然后执行：

Application.FindFormat.Interior.ColorIndex = 1

这将使单元格变为黑色

现在执行如下操作：

Debug.Print ActiveCell.Parent.Cells.Find(What:="*", SearchFormat:=True).Address

这应该会找到那些单元格。因此，您应该能够使用 FindFormat 函数定义所需的字体。

顺便说一句，在找不到任何匹配项的情况下，请务必测试返回的范围是否为空。

希望对您有所帮助。

编辑：

我使用 find 方法的原因是您的代码检查了两列中的每个单元格。 Find 方法应该更快。

您将需要一个 Do - While 循环来查找范围内的所有单元格，这与 VBA 中的 Find 函数很常见。

如果你运行这个函数，它应该调试你正在寻找的任何字体匹配的地址 - 对于一个特定的工作表。这应该给你的想法......

Sub FindCells()

Dim rData As Range, rPtr As Range
Set rData = ActiveSheet.Range("A:B")

Application.FindFormat.Clear
Application.FindFormat.Font.Color = vbBlue
Set rPtr = rData.Find(What:="*", SearchFormat:=True)
If Not rPtr Is Nothing Then
    Debug.Print rPtr.Address
End If

Application.FindFormat.Clear
Application.FindFormat.Font.Color = vbGreen
Set rPtr = rData.Find(What:="*", SearchFormat:=True)
If Not rPtr Is Nothing Then
    Debug.Print rPtr.Address
End If


End Sub

那好吧 - 对不起，一直分心.. 此代码将使用您的字体搜索特定数据范围的单元格。 我相信你只需要在代码中实现你的逻辑......

Option Explicit

Public Sub Test()

Dim rData As Range
Set rData = Sheet1.Range("A:B")

Call EnumerateFontColours(rData, vbBlue)

Call EnumerateFontColours(rData, vbGreen)

End Sub

Public Sub EnumerateFontColours(ByVal DataRange As Range, ByVal FontColour As Long)

Dim rPtr As Range
Dim sStartAddress As String
Dim bCompleted As Boolean

Application.FindFormat.Clear
Application.FindFormat.Font.Color = FontColour

Set rPtr = DataRange.Find(What:="*", SearchFormat:=True)
If Not rPtr Is Nothing Then
    sStartAddress = rPtr.Address
    Do
        '**********************
        Call ProcessData(rPtr)
        '**********************
        Set rPtr = DataRange.Find(What:="*", After:=rPtr, SearchFormat:=True)
        If Not rPtr Is Nothing Then
            If rPtr.Address = sStartAddress Then bCompleted = True
        Else
            bCompleted = True
        End If
    Loop While bCompleted = False
End If

End Sub

Public Sub ProcessData(ByVal r As Range)

Debug.Print r.Address

End Sub

Answer 2

您的代码存在多个问题：

1. 您的循环是嵌套的。每次准备一行时，您都在搜索所有数据。 ==> 将内部循环移到您正在着色的循环后面。
2. 结果消息Msg = Msg & Chr(10) & i 是在If Cells(i, 1).Font.Color = vbBlue And... 条件之外构造的，这意味着每一行都将写入结果字符串。将此部分移动到第二个循环中，字符串应该只包含蓝线。
3. 另外，请不要循环访问For Each Cell In Range("A:B")。这将检查这些列中的每个 单元格，远远超出那些包含实际数据的单元格。在第一个循环中使用LastRow。