循环遍历一个范围内的所有字体彩色单元格 [英] Loop through all font colored cells in a range
问题描述
我只想使用范围内的字体彩色单元格并以不同的颜色标记。而 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
如果Cells（i + 1，2） 。值 - 细胞（i，2）.Value<> 0然后
单元格（i，2）.Font.Color = vbBlue
单元格（i，1）.Font.Color = vbBlue
对于范围内的每个单元格（A ：B）
如果Cells（i，1）.Font.Color = vbBlue和Cells（i + 1，1）.Value - Cells（i，1）.Value> 4然后
细胞（i，2）.Font.Color = vbGreen
细胞（i，1）.Font.Color = vbGreen
结束如果
下一个
消息=消息& Chr（10）&我& &细胞（i，2）.Value& ：& - >&单元格（i，1）.Value
End If
Next i
MsgBox Msg，vbInformation
我相信你应该能够使用Find函数来执行此操作。
例如，选择一个单元格，然后执行：
Application.FindFormat.Interior.ColorIndex = 1
现在执行如下操作： > Debug.Print ActiveCell.Parent.Cells.Find（What：=*，SearchFormat：= True）.Address
这应该找到那些单元格。所以你应该能够使用FindFormat函数来定义你需要的字体。
BTW，确保测试返回的范围对于没有找到任何比赛..
希望有所帮助。
编辑：
我将使用find方法的原因是因为您的代码会检查两列中的每个单元格。 Find方法应该更快。
您将需要一个Do-While循环来查找与VBA中的查找功能相同范围内的所有单元格。
如果您运行此功能，它应调试您正在寻找的任何字体匹配的地址 - 对于特定工作表。这应该给你的想法...
Sub FindCells（）
Dim rData As Range， rPtr As Range
设置rData = ActiveSheet.Range（A：B）
Application.FindFormat.Clear
Application.FindFormat.Font.Color = vbBlue
设置rPtr = rData.Find（什么：=*，SearchFormat：= True）
如果不是rPtr不是然后
Debug.Print rPtr.Address
如果
Application.FindFormat.Clear
Application.FindFormat.Font.Color = vbGreen
设置rPtr = rData.Find（什么：=*，SearchFormat：= True）
如果不是rPtr没有，然后
Debug.Print rPtr.Address
如果
End Sub
好的，抱歉，不断分心..
此代码将搜索具有特定数据范围的字体的单元格。
我相信你只需要在代码中实现你的逻辑...
Option Explicit
公共子测试（）
Dim rData As Range
设置rData = Sheet1.Range（A：B）
调用EnumerateFontColours（rData， vbBlue）
调用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
设置rPtr = DataRange.Find（什么：=*，SearchFormat：= True）
如果不是rPtr是没有
sStartAddress = rPtr.Address
Do
'**********************
调用ProcessData（rPtr）
'***** *****************
设置rPtr = DataRange.Find（什么：=*，之后：= rPtr，SearchFormat：= True）
如果不是rPtr不是n
如果rPtr.Address = sStartAddress then bCompleted = True
Else
bCompleted = True
End If
循环while bCompleted = False
End If
End Sub
公共子进程数据（ByVal r As Range）
Debug.Print r.Address
End Sub
I extracted the data according to ciriteria and marked them as blue. I'm looking for help with a Macro which would loop through all font colored cells (Blue) in a range.
I want to use only font colored cells in a range and mark in different color. And Msgbox show data that meet the criteria.
I had trouble finding information on looping through cells which contain only a specified colour. Anyone know how this could be done?
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
I believe you should be able to use the Find function to do this....
For example, select some cells on a sheet then execute:
Application.FindFormat.Interior.ColorIndex = 1
This will colour the cells black
Now execute something like:
Debug.Print ActiveCell.Parent.Cells.Find(What:="*", SearchFormat:=True).Address
This should find those cells. So you should be able to define your required Font with the FindFormat function.
BTW, make sure to test to see if the range returned is nothing for the case where it cant find any matches..
Hope that helps.
Edit:
The reason I would use the find method is because your code checks each cell in two columns. The Find method should be much quicker.
You will need to have a Do - While loop to find all cells in a range which is common with the Find function in VBA.
If you run this function, it should debug the address of any font matches that you are looking for - for a particular sheet. This should give you the idea...
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
Ok then - sorry keep getting distracted.. This code will search for cells with your fonts for a particular data range. I believe you just need to implement your logic into the code...
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
这篇关于循环遍历一个范围内的所有字体彩色单元格的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
