为 Excel 中的单元格内的部分文本着色
Coloring partial text within cells in Excel
我需要将 [方括号] 中的所有内容以及这些 <brackets>
中的所有 HTML/XML 标记在所有单元格中选定的 sheet 上涂成通用红色。单元格中的其余文本需要保持黑色。
我曾尝试修改附加代码,但只能将括号变成红色,而其余文本仍为黑色。我想我需要添加正则表达式范围 \[.*?\]
和 \<.*?\>
但不确定如何添加。请帮忙!
Sub Format_Characters_In_Found_Cell()
Dim Found As Range, x As String, FoundFirst As Range
x = "["
y = "]"
On Error Resume Next
Set Found = Cells.Find(what:=x, LookIn:=xlValues, LookAt:=xlPart)
If Not Found Is Nothing Then
Set FoundFirst = Found
Do
'Format "x"
With Found.Characters(Start:=InStr(Found.Text, x), Length:=Len(y))
.Font.ColorIndex = 3
.Font.Bold = False
End With
Set Found = Cells.FindNext(Found)
Loop Until FoundFirst.Address = Found.Address
Else
MsgBox x & " could not be found.", , " "
End If
End Sub
Len(y)
(当 y
包含单个字符时)将始终 return 值为 1。
您所追求的正确长度是字符串中 x
与字符串中 y
之间的字符数,因此您需要使用类似:
With Found.Characters(Start:=InStr(Found.Text, x), _
Length:=Instr(Found.Text, y) - Instr(Found.Text, x) + 1)
或者,如果你不想给括号本身上色,你可以在起始位置上加 1 并从长度中减去 2,从而得到:
With Found.Characters(Start:=InStr(Found.Text, x) + 1, _
Length:=Instr(Found.Text, y) - Instr(Found.Text, x) - 1)
为了满足 [...]
和 <...>
我的偏好是修改子例程以允许将要搜索的括号类型作为参数传递,然后调用子例程两次.
Sub Test
Format_Characters_In_Found_Cell "[", "]"
Format_Characters_In_Found_Cell "<", ">"
End Sub
Sub Format_Characters_In_Found_Cell(x As String, y As String)
Dim Found As Range, FoundFirst As Range
On Error Resume Next
Set Found = Cells.Find(what:=x, LookIn:=xlValues, LookAt:=xlPart)
If Not Found Is Nothing Then
Set FoundFirst = Found
Do
'Format "x"
With Found.Characters(Start:=InStr(Found.Text, x), _
Length:=Instr(Found.Text, y) - Instr(Found.Text, x) + 1)
.Font.ColorIndex = 3
.Font.Bold = False
End With
Set Found = Cells.FindNext(Found)
Loop Until FoundFirst.Address = Found.Address
Else
MsgBox x & " could not be found.", , " "
End If
End Sub
迭代,并允许在单个单元格中使用多个括号实例:
Sub Format_Characters_In_Found_Cell(x As String, y As String)
Dim Found As Range, FoundFirst As Range
Dim posStart As Long
Dim posEnd As Long
On Error Resume Next
Set Found = Cells.Find(what:=x, LookIn:=xlValues, LookAt:=xlPart)
If Not Found Is Nothing Then
Set FoundFirst = Found
Do
'Format "x"
posStart = InStr(Found.Text, x)
Do While posStart > 0
posEnd = InStr(posStart + 1, Found.Text, y)
If posEnd = 0 Then
Exit Do ' no matching end bracket
End If
With Found.Characters(Start:=posStart, Length:=posEnd - posStart + 1)
.Font.ColorIndex = 3
.Font.Bold = False
End With
posStart = InStr(posEnd + 1, Found.Text, x)
Loop
Set Found = Cells.FindNext(Found)
Loop Until FoundFirst.Address = Found.Address
Else
MsgBox x & " could not be found.", , " "
End If
End Sub
Sub Format_Characters_In_Found_Cell()
Dim Found As Range, x As String, FoundFirst As Range
x = "["
y = "]"
On Error Resume Next
Set Found = Cells.Find(what:=x, LookIn:=xlValues, LookAt:=xlPart)
If Not Found Is Nothing Then
Set FoundFirst = Found
Do
'Format "x"
l = InStr(Found.Text, y) - InStr(Found.Text, x) + 1
With Found.Characters(Start:=InStr(Found.Text, x), Length:=l)
.Font.ColorIndex = 3
.Font.Bold = False
End With
Set Found = Cells.FindNext(Found)
Loop Until FoundFirst.Address = Found.Address
Else
MsgBox x & " could not be found.", , " "
End If
End Sub
我需要将 [方括号] 中的所有内容以及这些 <brackets>
中的所有 HTML/XML 标记在所有单元格中选定的 sheet 上涂成通用红色。单元格中的其余文本需要保持黑色。
我曾尝试修改附加代码,但只能将括号变成红色,而其余文本仍为黑色。我想我需要添加正则表达式范围 \[.*?\]
和 \<.*?\>
但不确定如何添加。请帮忙!
Sub Format_Characters_In_Found_Cell()
Dim Found As Range, x As String, FoundFirst As Range
x = "["
y = "]"
On Error Resume Next
Set Found = Cells.Find(what:=x, LookIn:=xlValues, LookAt:=xlPart)
If Not Found Is Nothing Then
Set FoundFirst = Found
Do
'Format "x"
With Found.Characters(Start:=InStr(Found.Text, x), Length:=Len(y))
.Font.ColorIndex = 3
.Font.Bold = False
End With
Set Found = Cells.FindNext(Found)
Loop Until FoundFirst.Address = Found.Address
Else
MsgBox x & " could not be found.", , " "
End If
End Sub
Len(y)
(当 y
包含单个字符时)将始终 return 值为 1。
您所追求的正确长度是字符串中 x
与字符串中 y
之间的字符数,因此您需要使用类似:
With Found.Characters(Start:=InStr(Found.Text, x), _
Length:=Instr(Found.Text, y) - Instr(Found.Text, x) + 1)
或者,如果你不想给括号本身上色,你可以在起始位置上加 1 并从长度中减去 2,从而得到:
With Found.Characters(Start:=InStr(Found.Text, x) + 1, _
Length:=Instr(Found.Text, y) - Instr(Found.Text, x) - 1)
为了满足 [...]
和 <...>
我的偏好是修改子例程以允许将要搜索的括号类型作为参数传递,然后调用子例程两次.
Sub Test
Format_Characters_In_Found_Cell "[", "]"
Format_Characters_In_Found_Cell "<", ">"
End Sub
Sub Format_Characters_In_Found_Cell(x As String, y As String)
Dim Found As Range, FoundFirst As Range
On Error Resume Next
Set Found = Cells.Find(what:=x, LookIn:=xlValues, LookAt:=xlPart)
If Not Found Is Nothing Then
Set FoundFirst = Found
Do
'Format "x"
With Found.Characters(Start:=InStr(Found.Text, x), _
Length:=Instr(Found.Text, y) - Instr(Found.Text, x) + 1)
.Font.ColorIndex = 3
.Font.Bold = False
End With
Set Found = Cells.FindNext(Found)
Loop Until FoundFirst.Address = Found.Address
Else
MsgBox x & " could not be found.", , " "
End If
End Sub
迭代,并允许在单个单元格中使用多个括号实例:
Sub Format_Characters_In_Found_Cell(x As String, y As String)
Dim Found As Range, FoundFirst As Range
Dim posStart As Long
Dim posEnd As Long
On Error Resume Next
Set Found = Cells.Find(what:=x, LookIn:=xlValues, LookAt:=xlPart)
If Not Found Is Nothing Then
Set FoundFirst = Found
Do
'Format "x"
posStart = InStr(Found.Text, x)
Do While posStart > 0
posEnd = InStr(posStart + 1, Found.Text, y)
If posEnd = 0 Then
Exit Do ' no matching end bracket
End If
With Found.Characters(Start:=posStart, Length:=posEnd - posStart + 1)
.Font.ColorIndex = 3
.Font.Bold = False
End With
posStart = InStr(posEnd + 1, Found.Text, x)
Loop
Set Found = Cells.FindNext(Found)
Loop Until FoundFirst.Address = Found.Address
Else
MsgBox x & " could not be found.", , " "
End If
End Sub
Sub Format_Characters_In_Found_Cell()
Dim Found As Range, x As String, FoundFirst As Range
x = "["
y = "]"
On Error Resume Next
Set Found = Cells.Find(what:=x, LookIn:=xlValues, LookAt:=xlPart)
If Not Found Is Nothing Then
Set FoundFirst = Found
Do
'Format "x"
l = InStr(Found.Text, y) - InStr(Found.Text, x) + 1
With Found.Characters(Start:=InStr(Found.Text, x), Length:=l)
.Font.ColorIndex = 3
.Font.Bold = False
End With
Set Found = Cells.FindNext(Found)
Loop Until FoundFirst.Address = Found.Address
Else
MsgBox x & " could not be found.", , " "
End If
End Sub