基於範圍的excel格式字符串

Question

所以我有長文本的列A，其中提到了幾個名字。列中的每個單元格都是一個小型文章。一些重要的名稱在每個單元格中都重複出現，我需要用不同的顏色突出顯示這些名稱。所以，一個當它找到這些名字時有條件格式化的宏。

我能夠做到這一點，當我正在尋找的名稱是固定的，但我一直在試圖找到一種方法來搜索名單列表（在表B），以便我可以添加到此必要時列出名稱。我一直在尋找谷歌和這裏，但我只找到基於1）一個特定的文本字符串，或2）單個單元格的方法。我無法弄清楚如何將發現映射到可變範圍的單元格。

使用Excel 2003

按名稱：

Sub FormatTest() 
Dim g As Range 
For Each g In Selection.Cells 
    FormatCell g 
Next 
End Sub 


Sub FormatCell(g As Range) 
Dim pos1 As Integer, pos2 As Integer 
pos1 = 1 
pos2 = InStr(pos1, g.Text, "Alicia") 
v = Len("Alicia") 
pos3 = pos2 + v 
g.Characters(Start:=pos2, Length:=pos3 - pos2).Font.Color = RGB(0, 0, 255)  
End Sub 

通過細胞：

Sub FormatTest() 
Dim e As Range 
For Each e In Selection.Cells 
    FormatCell e 
Next 
End Sub 
Sub FormatCell(e As Range) 
Dim pos1 As Integer, pos2 As Integer 
pos1 = 1 
pos2 = InStr(pos1, e.Text, Range("B20")) 
v = len(Range("B20")) 
pos3 = pos2 + v 
e.Characters(Start:=pos2, Length:=pos3 - pos2).Font.Color = RGB(0, 0, 255) 

Answer 1

此更新到您的代碼將做到這一點，但將無法正常工作（就像你的初始代碼）如果在一個單元中有多個名稱的實例。會發生嗎？

Sub FormatTest() 
Dim g As Range, rgWords As Range, rgWord As Range 

'turn off updates to speed up code execution 
With Application 
    .ScreenUpdating = False 
    .EnableEvents = False 
    .Calculation = xlCalculationManual 
    .DisplayAlerts = False 
End With 

'set the range where you keep the list of words you're searching for here: 
Set rgWords = Sheets("Sheet2").Range("A1:A3") 

For Each g In Selection.Cells 
    For Each rgWord In rgWords.Cells 
     if len(rgWord)>0 then FormatCell g, rgWord.Text 
    Next rgWord 
Next 

With Application 
    .ScreenUpdating = True 
    .EnableEvents = True 
    .Calculation = xlCalculationAutomatic 
    .DisplayAlerts = True 
End With 

End Sub 


Sub FormatCell(g As Range, sWord As String) 
Dim pos1 As Integer, pos2 As Integer 
pos1 = 1 
pos2 = InStr(pos1, g.Text, sWord) 
If pos2 = 0 Then Exit Sub 
v = Len(sWord) 
pos3 = pos2 + v 
g.Characters(Start:=pos2, Length:=pos3 - pos2).Font.Color = RGB(0, 0, 255) 
End Sub 

如果你可以有多個實例，更新FormatCell分以下：

Sub FormatCell(g As Range, sWord As String) 
Dim pos1 As Integer, pos2 As Integer 
pos1 = 1 
pos2 = InStr(pos1, g.Text, sWord) 
v = Len(sWord) 

Do While pos2 > 0 

    pos3 = pos2 + v 
    g.Characters(Start:=pos2, Length:=pos3 - pos2).Font.Color = RGB(0, 0, 255) 

    pos2 = InStr(pos2 + v, g.Text, sWord) 

Loop 
End Sub