excel基于范围的格式string

所以我有长文本的A列，其中提到了几个名字。 列中的每个单元格都是一个小型文章。 一些重要的名字在每个单元格中都重复出现，我需要用不同的颜色突出显示这些名称。 所以，一个当它find这些名字时有条件地格式化的macros。

我能够做到这一点，当我正在寻找的名称是固定的，但我一直在试图find一种方法来search名单的名单（在表B），以便我可以添加到这个名单列表并在必要时。 我一直在寻找谷歌和这里，但我只find方法find基于1）一个特定的文本string，或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