在两个相同字符之间查找文本并更改其字体颜色

Question

我正在处理的文本格式如下所示：

|约翰| 买了一个|苹果|。

目标是找到“|”之间的所有文本（如“John”和“apple”），更改其颜色然后删除两个“|”。

我当前的代码应该通过两个位置之间的每个字符找到“|”的第一个和第二个实例 go 然后更改其字体颜色，删除两个“|” 并循环再次执行整个操作，直到没有“|” 可以被找寻到。

我的问题是它经常删除和着色错误的字符。 我怀疑它与角色位置有关，但我不知道在哪里。

相关代码如下所示：

       Dim Cell As Range
       Dim iChr As Integer, N As Integer, Content As Integer
       Dim openPos As Long, Dim clsPos As Long
       Dim textBetween As String

       For Each Cell In ws.UsedRange' relevant code is going to loop through each cell of each sheet

            openPos = 0
            N = 1

         iChr = InStr(1, Cell.Value, "|")
         Do Until iChr = 0 'Loop until no "|"

            openPos = InStr(openPos + N, Cell, "|", vbTextCompare) 'first "|"
            clsPos = InStr(openPos + 1 + N, Cell, "|", vbTextCompare) 'second "|"

                For Content = openPos To clsPos
                    Cell.Characters(Content, 1).Font.Color = RGB(0, 255, 0)
                Next Content

            N = N + 1

            Cell.Characters(clsPos, 1).Delete 'delete first and second"|"
            Cell.Characters(openPos, 1).Delete

            iChr = InStr(1, Cell.Value, "^") 'check if there is any "|" left
         Loop

       Next Cell

Answer 1

请尝试此代码。

Sub FindColorAndRemove()
    ' 016

    Const Marker As String = "|"                ' change to suit

    Dim Ws As Worksheet
    Dim Fnd As Range, FirstFound As String
    Dim Sp() As String
    Dim n As Integer
    Dim i As Integer

    For Each Ws In ActiveWorkbook.Worksheets
        ' enumerate exclusions here
        If Ws.CodeName <> Sheet1.CodeName Then
            Set Fnd = Ws.Cells.Find(What:=Marker & "*" & Marker, _
                   After:=Ws.Cells(1, 1), _
                   LookIn:=xlValues, _
                   LookAt:=xlPart, _
                   SearchDirection:=xlNext)
            If Not Fnd Is Nothing Then
                FirstFound = Fnd.Address
                Do
                    With Fnd
                        Sp = Split(.Value, Marker)
                        n = 0
                        .Value = Join(Sp, "")

                        For i = 0 To UBound(Sp) - 1
                            If i Mod 2 Then
                                With .Characters(n + 1, Len(Sp(i)))
                                    .Font.Color = vbRed
                                    .Font.Bold = True
                                End With
                            End If
                            n = n + Len(Sp(i))
                        Next i
                    End With

                    Set Fnd = Ws.Cells.FindNext
                    If Fnd Is Nothing Then Exit Do
                Loop While Fnd.Address <> FirstFound
            End If
        End If
    Next Ws
End Sub

请注意这行代码If Ws.CodeName <> Sheet1.CodeName Then 。 我添加它是因为我不希望包含所有工作表。 您可以使用工作表的选项卡名称或代码名称。 我推荐CodeName ，因为用户不太可能更改它。 如果您不需要该功能，您可以使用一些不相关的标准或删除整个 IF 语句，包括其 End If。

Answer 2

这是使用 Collection 的另一种方法

Sub Find_Location()

Dim iChr, StartChar, CharLen, i, j, k, m, n As Integer
Dim Ws As Worksheet
Set Ws = ActiveSheet
Dim Occurrence As Collection

    For Each Cell In Ws.UsedRange

        Set Occurrence = New Collection
        i = Len(Cell.Text)

        If i = 0 Then GoTo EndOfForLoop
            j = 1
            k = 0

            Do Until j > i
                iChr = InStr(j, Cell.Value, "|")

                If iChr = 1 Then
                    k = k + 1
                    Occurrence.Add iChr
                ElseIf iChr > 1 Then
                    k = k + 1
                    If Occurrence.Count = 0 Then
                        Occurrence.Add iChr
                    ElseIf Occurrence.Count > 0 Then
                        If (k / 2) = Int(k / 2) Then
                            Occurrence.Add (iChr - k)
                        ElseIf (k / 2) <> Int(k / 2) Then
                            Occurrence.Add (iChr - Occurrence.Count)
                        End If
                    End If
                ElseIf iChr = 0 Then
                    If k = 0 Then
                        GoTo EndOfForLoop
                    Else
                        GoTo ModifyContent
                    End If
                End If

                j = 1 + iChr
            Loop
ModifyContent:
        With Cell
        .Replace "|", ""
        End With

            m = 1
            n = 2
            Do Until n > k
                StartChar = Occurrence.Item(m)
                CharLen = (Occurrence.Item(n) - Occurrence.Item(m) + 1)
                With Cell.Characters(StartChar, CharLen)
                    .Font.Color = RGB(0, 255, 0)
                    .Font.Bold = True
                End With
                m = m + 2
                n = n + 2
            Loop
EndOfForLoop:
    Next
End Sub