Question

我需要让[方括号]中的所有内容和这些<brackets>中的所有HTML / XML标记在所有单元格的选定工作表上以通用红色着色。单元格中的其余文本需要保持黑色。

我尝试修改附加代码，但只能将括号变为红色，而其余文本则保留为黑色。我想我需要添加正则表达式范围\[.*?\]和\<.*?\>但不确定如何。请帮忙！

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

Answer 1

Len(y)（当y包含单个字符时）将始终返回值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)

为了满足[...]和<...>，我的偏好是修改子程序以允许被搜索的括号类型作为参数传递，然后调用子程序两次。 / p>

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

Answer 2

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

在Excel中的单元格内着色部分文本

2 个答案: