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