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

Question

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

我想只使用范围内的字体颜色单元格并以不同颜色标记。 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函数定义所需的Font。

顺便说一句，确保测试看看返回的范围是否无法找到任何匹配的情况。

希望有所帮助。

编辑：

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