VBA查找包含多个单词的单元格，并将一个单词的字体颜色更改为红色

Question

我需要一个VBA来查找H列中包含单词"的单元格；仅"；以及单词"；可用"；在同一单元格中，并忽略所有其他出现的"；仅"；。然后我想把"；仅"；转换为红色，而不改变单元格中其他单词的颜色。

这是我迄今为止所拥有的。它发现所有"；仅"；但我不知道如何在同一个单元格中搜索两个单词。

Public Sub ChgTxtColor()
Set myRange = Range("H1:H400")
substr = "only"
txtColor = 3

For Each MyString In myRange
lenstr = Len(MyString)
lensubstr = Len(substr)
For i = 1 To lenstr
tempString = Mid(MyString, i, lensubstr)
If tempString = substr Then
MyString.Characters(Start:=i, 
Length:=lensubstr).Font.ColorIndex = txtColor
End If
Next i
Next MyString
End Sub

Answer 1

试试这个：

Public Sub ChgTxtColor()
Dim myRange As Range, txtColor As Long, c As Range, v

Set myRange = Range("H1:H400")
txtColor = vbRed
For Each c In myRange.Cells       'loop each cell in range
v = c.Value
'If FindBoldText(c, "only") > 0 Then 'bolded text only
If InStr(1, v, "only", vbTextCompare) > 0 Then
'If FindBoldText(c, "available") > 0 Then 'bolded text only
If InStr(1, v, "available", vbTextCompare) > 0 Then
HilightAllInCell c, "only", txtColor
End If
End If
Next c
End Sub
'Find the position of string `txt` in a cell `c` as long as it's bolded
'  Returns 0 if txt is not found or is present but not bolded
Function FindBoldText(c As Range, txt As String) As Long
Dim pos As Long, rv As Long, bld, v
v = c.Value
bld = c.Font.Bold  'will be True, False, or Null (cell has mixed bold formatting)
If bld = False Or Len(v) = 0 Then Exit Function 'no bold text or no content...
pos = InStr(1, c.Value, txt, vbTextCompare)
If pos > 0 Then
If bld = True Then 'whole cell is bold?
FindBoldText = pos
ElseIf IsNull(bld) Then 'mixed bold formatting?
If c.Characters(pos, Len(txt)).Font.Bold Then FindBoldText = pos
End If
End If
End Function
'hilight all instances of `findText` in range `c` using text color `hiliteColor`
Sub HilightAllInCell(c As Range, findText As String, hiliteColor As Long)
Dim v, pos As Long
v = c.Value
If Len(v) > 0 Then     'any text to check?
pos = 0            'set start position
Do
pos = InStr(pos + 1, v, findText, vbTextCompare) 'case-insensitive
If pos > 0 Then  'found?
'using Color instead of ColorIndex is more reproducible
'  (since users can edit their color pallette)
c.Characters(Start:=pos, Length:=Len(findText)).Font.Color = hiliteColor
Else
Exit Do    'not found, or no more matches
End If
Loop               'look again
End If                 'anything to check
End Sub