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

基于范围的excel格式字符串

1 个答案: