在兩個相同字符之間查找文本並更改其字體顏色

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