在Excel單元格中對部分文本進行着色

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到開始POSI灰和來自長度減去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 

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