Excel VBA 查找文本并应用字体颜色

Question

我的 Excel 文件

• 两个工作表：报告和离开

• 一个命名范围： Leavings （ Leaving工作表中的全名列表， A 列，一些名字是红色的，另一些是橙色的）。

我的目标

我希望我的宏在报告工作表中（特别是在 G 到 M 列中）找到属于Leavers命名范围的所有名称，并将匹配的字体颜色应用于找到的每个单元格。

我的代码（到目前为止...）

此代码可以通过一一搜索来提供帮助，但与使用 Ctrl + F 手动操作并没有太大变化。 我找不到其他方法。 随意提供更好的替代方案、代码和解决方案。

Dim Sh As Worksheet
Dim Found As Range
Dim Nme As String
Dim Adr1 As String
 
Nme = Application.InputBox("Enter Name to search", "Test")
 
Set Sh = Sheets("Sheet1")
 
With Sh.Range("A2:A")
 
   Set Found = .Find(What:=Nme, After:=.Range("A2"), _
       LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlNext, _
       MatchCase:=False, SearchFormat:=False)
    If Not Found Is Nothing Then
        Adr1 = Found.Address
    Else
       MsgBox "Name could not be found"
       Exit Sub
    End If
    Do
       Found.Interior.ColorIndex = 4
       Set Found = .FindNext(Found)
    Loop Until Found Is Nothing Or Found.Address = Adr1
End With
End Sub

Answer 1

尝试这个：

我试图坚持使用您现有的一些代码，但我不得不进行一些更改。

1. 您需要遍历您的第一个范围（我在Sheet1上使用了“G2：M1000”，我猜这是您的report页面？）

2. 您不能在查找例程中使用像"A2:A"这样的范围，所以我再次任意使用了 1000 限制： "A2:A1000"

3. 您使用的是内部单元格颜色，而不是字体颜色，我已更改此设置，但如果您确实指的是内部颜色，则只需将其换回

4. 我没有使用"Exit Sub" ，因为这将在第一次遇到空白单元格/没有匹配名称时停止所有运行。

Sub eh()

Dim rng As Range: Set rng = Sheet1.Range("G2:M1000")
Dim v As Range
Dim c As Variant

Dim Found As Range
Dim Nme As String
Dim Adr1 As String

For Each v In rng
    Nme = v.Value2
    If Nme <> "" Then
        Set Found = Sheet2.Range("A2:A1000").Find(What:=Nme, After:=Sheet2.Range("A2"), LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlNext, MatchCase:=False, SearchFormat:=False)
        If Not Found Is Nothing Then
            v.Font.Color = Found.Font.Color
        End If
    End If
Next v

End Sub

Answer 2

我尝试了一种不同的方法，我有一个子过程来遍历离开者的范围，当我找到一个值时，我将它交给另一个过程以在报告范围中查找该值。 我正在复制单元格的所有格式，您可以将其更改为仅复制字体颜色。 此外，您应该检查每个范围的末端，以进行优化，并且如果在离开者范围内重复相同的名称，则此代码将循环多次以获得相同的名称，这可以改进。

Sub select_name() 'Select every cell in the leavers range

Dim leaving_range As Range
Dim row_leaving As Range


Set leaving_range = Sheets("Leaving").Range("A2:A10") 'The leavers list, check for the end of the range

For Each row_leaving In leaving_range.Rows

    If row_leaving.Cells(1, 1).Text <> "" Then
        row_leaving.Cells(1, 1).Copy 'I am gonna copy all the format, you change it to copy just the font color
        
        Call look_for_name(row_leaving.Cells(1, 1).Text)

    End If

Next


End Sub


Sub look_for_name(name_to_find As String) 'look for a name in the report range and change the format

Dim report_range As Range
Dim row_report As Range

Set report_range = Sheets("Report").Range("G1:M5") 'the report range where the names are to be found

For Each row_report In report_range.Rows

    For Each cell In row_report.Cells
        
        If cell.Value = name_to_find Then
            cell.PasteSpecial Paste:=xlPasteFormats
        End If

    Next

Next

End Sub