根据另一个单元格突出显示一个单元格中的特定文本
Highlight specific text in one cell based on another cell
我在 I 列和 H 列中的值很少,我有一个代码可以突出显示 H 列中的特定词,如果这些词恰好出现在 I 列中的话。
缺点是只有当它们完全相同并且一起出现时才会突出显示作品,可以在代码中进行任何更改并突出显示每个单词即使它们不在一起
附上我想要的与我拥有的图片,同时附上现有代码。
Dim c1 As Range, c2 As Range, md As Variant, i As Long, w1 As String, os As Long
Set c1 = Range("I2")
Set c2 = Range("H2")
md = Range(c1, Cells(Rows.Count, c1.Column).End(xlUp)).Value
For i = 1 To UBound(md)
If md(i, 1) <> "" Then
w1 = c2.Cells(i, 1).Value
os = InStr(1, w1, md(i, 1), vbTextCompare)
While os > 0
c2.Cells(i, 1).Characters(Start:=os, Length:=Len(md(i, 1))).Font.Color = vbBlue
os = InStr(os + 1, w1, md(i, 1), vbTextCompare)
Wend
End If
Next i
如果有人能解决我的问题,那将是一个很大的帮助。
对于模式匹配,使用正则表达式。
Option Explicit
Sub markup()
Dim regex As Object, m As Object, ar
Dim pattern As String, s As String
Dim Lastrow As Long, i As Long, k As Long, n As Long, p As Long
' Create regular expression.
Set regex = CreateObject("VBScript.RegExp")
With regex
.IgnoreCase = True
.Global = True
End With
'update sheet
With ActiveSheet
Lastrow = .Cells(.Rows.Count, "I").End(xlUp).Row
For i = 2 To Lastrow
pattern = Replace(.Cells(i, "I"), ",", "|")
If Len(pattern) > 0 Then
regex.pattern = pattern
s = .Cells(i, "H")
If regex.test(s) Then
' markup matches
Set m = regex.Execute(s)
For k = 0 To m.Count - 1
p = m(k).firstindex + 1
n = Len(m(k))
With .Cells(i, "H").Characters(Start:=p, Length:=n)
.Font.Color = vbBlue
.Font.Bold = True
End With
Next
End If
End If
Next
End With
End Sub
我在 I 列和 H 列中的值很少,我有一个代码可以突出显示 H 列中的特定词,如果这些词恰好出现在 I 列中的话。
缺点是只有当它们完全相同并且一起出现时才会突出显示作品,可以在代码中进行任何更改并突出显示每个单词即使它们不在一起
附上我想要的与我拥有的图片,同时附上现有代码。
Dim c1 As Range, c2 As Range, md As Variant, i As Long, w1 As String, os As Long
Set c1 = Range("I2")
Set c2 = Range("H2")
md = Range(c1, Cells(Rows.Count, c1.Column).End(xlUp)).Value
For i = 1 To UBound(md)
If md(i, 1) <> "" Then
w1 = c2.Cells(i, 1).Value
os = InStr(1, w1, md(i, 1), vbTextCompare)
While os > 0
c2.Cells(i, 1).Characters(Start:=os, Length:=Len(md(i, 1))).Font.Color = vbBlue
os = InStr(os + 1, w1, md(i, 1), vbTextCompare)
Wend
End If
Next i
如果有人能解决我的问题,那将是一个很大的帮助。
对于模式匹配,使用正则表达式。
Option Explicit
Sub markup()
Dim regex As Object, m As Object, ar
Dim pattern As String, s As String
Dim Lastrow As Long, i As Long, k As Long, n As Long, p As Long
' Create regular expression.
Set regex = CreateObject("VBScript.RegExp")
With regex
.IgnoreCase = True
.Global = True
End With
'update sheet
With ActiveSheet
Lastrow = .Cells(.Rows.Count, "I").End(xlUp).Row
For i = 2 To Lastrow
pattern = Replace(.Cells(i, "I"), ",", "|")
If Len(pattern) > 0 Then
regex.pattern = pattern
s = .Cells(i, "H")
If regex.test(s) Then
' markup matches
Set m = regex.Execute(s)
For k = 0 To m.Count - 1
p = m(k).firstindex + 1
n = Len(m(k))
With .Cells(i, "H").Characters(Start:=p, Length:=n)
.Font.Color = vbBlue
.Font.Bold = True
End With
Next
End If
End If
Next
End With
End Sub