试试这个，它会向后遍历单元格中的每个字符，如果该字符不是粗体，而它后面的字符是粗体，那么它会添加一个分号（分号本身是粗体）

Sub AddSemicolonBeforeBoldText()
    Dim rng As Range
    Dim cell As Range
    
    Set rng = ActiveSheet.UsedRange
    
    For Each cell In rng
        If cell.HasFormula Then
            ' Skip cells with formulas
            GoTo ContinueLoop
        End If
        
        Dim i As Long
        For i = cell.Characters.Count - 2 To 0 Step -1
            If i = 0 Or Not cell.Characters(i, 1).Font.Bold Then
                If cell.Characters(i + 1, 1).Font.Bold Then
                    cell.Characters(i + 1, 0).Insert ";"
                End If
            End If
        Next i
        
ContinueLoop:
    Next cell
End Sub

字符串
如果需要，还可以通过删除GoTo进一步整理代码，如下所示

Sub AddSemicolonBeforeBoldText()
    Dim rng As Range
    Dim cell As Range
    
    Set rng = ActiveSheet.UsedRange
    
    For Each cell In rng
        If Not cell.HasFormula Then
            Dim i As Long
            For i = cell.Characters.Count - 2 To 0 Step -1
                If i = 0 Or Not cell.Characters(i, 1).Font.Bold Then
                    If cell.Characters(i + 1, 1).Font.Bold Then
                        cell.Characters(i + 1, 0).Insert ";"
                    End If
                End If
            Next i
        End If
    Next cell
End Sub

型

答案已更新图片

密码会改变这一点。。

的数据
。到这个。。

的

加粗单元格行前置字符串

的数据

Sub PrependStringToBoldCellRow()
    
    Const INSERT_STRING As String = ";"
    Const PREVENT_CONSECUTIVE_INSERTIONS As Boolean = True
    Const MATCH_INSERT_STRING_CASE As Boolean = False
    Const CELL_ROW_DELIMITER As String = vbLf ' or vbCrLf?
    
    If ActiveSheet Is Nothing Then Exit Sub
    If Not TypeOf ActiveSheet Is Worksheet Then Exit Sub
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    Dim rng As Range: Set rng = ws.UsedRange
    
    Dim iLen As Long: iLen = Len(INSERT_STRING)
    Dim iCompare As VbCompareMethod:
    
    If MATCH_INSERT_STRING_CASE Then
        iCompare = vbBinaryCompare
    Else
        iCompare = vbTextCompare
    End If
    
    Application.ScreenUpdating = False
    
    Dim cell As Range, chars As Characters
    Dim sRows() As String, sStarts() As Long, sLens() As Long
    Dim u As Long, UB As Long, sStart As Long, sLen As Long
    Dim CellString As String, RowString As String
    Dim IsCellStringValid As Boolean, IsConsecutive As Boolean
    
    For Each cell In rng.Cells
        
        ' Validate
        If Not cell.HasFormula Then ' has no formula
            If VarType(cell.Value) = vbString Then
                CellString = CStr(cell.Value)
                If Len(CellString) > 0 Then
                    IsCellStringValid = True
                Else
                    Debug.Print "Cell """ & cell.Address(0, 0) & """ is blank."
                End If
            Else
                Debug.Print "Cell """ & cell.Address(0, 0) & """ has no string."
            End If
        Else
            Debug.Print "Cell """ & cell.Address(0, 0) & """ has a formula."
        End If
        
        If IsCellStringValid Then
            IsCellStringValid = False ' reset for the next cell
            Debug.Print "Processing cell """ & cell.Address(0, 0) & """."
            
            sRows = Split(CellString, CELL_ROW_DELIMITER)
            UB = UBound(sRows)
            ReDim sStarts(0 To UB): ReDim sLens(0 To UB)
            sStart = 1
            
            For u = 0 To UB
                sLen = Len(sRows(u))
                sStarts(u) = sStart
                sLens(u) = sLen
                sStart = sStart + sLen + 1
            Next u
            
            For u = UB To 0 Step -1
                Set chars = cell.Characters(sStarts(u), sLens(u))
                RowString = chars.Text
                
                If PREVENT_CONSECUTIVE_INSERTIONS Then
                    If InStr(1, RowString, INSERT_STRING, iCompare) _
                            = 1 Then ' begins with
                        IsConsecutive = True
                    End If
                End If
                
                If IsConsecutive Then
                    IsConsecutive = False ' reset for the next row string
                    Debug.Print vbTab & RowString & " (is bold; " _
                        & "prevented consecutive insertion)"
                Else
                    If chars.Font.Bold Then
                        Debug.Print vbTab & RowString & " (is bold; " _
                            & "inserting...)"
                        chars.Insert INSERT_STRING & RowString
                    Else
                        Debug.Print vbTab & RowString & " (is not bold)"
                    End If
                End If
            Next u
        End If
    
    Next cell
    
    Application.ScreenUpdating = True
    
    MsgBox "Semicolons prepended.", vbInformation
    
End Sub

字符串

日志

Processing cell "A1".
    I hated mice since I was little (is bold; inserting...)
    I hate mice (is not bold)
    I bought it with my own money (is not bold)
    I have a red bike (is bold; inserting...)
    I want to drink hot chocolate (is not bold)
    I really love chocolate (is not bold)
    I Love Chocolate (is bold; inserting...)
Cell "A2" has a formula.
Cell "A3" has no string.
Cell "A4" has no string.
Processing cell "A5".
    AAA (is not bold)
Processing cell "A6".
    AAA (is bold; inserting...)
Cell "A7" has no string.
Cell "A8" has no string.
Cell "A9" has no string.
Cell "A10" has no string.

型

Sub AddSemicolonToBoldText()
    Dim ws As Worksheet
    Dim rng As Range
    Dim cell As Range
    Dim i As Integer
    Dim text As String
    
    ' Set the worksheet to work with
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Replace "Sheet1" with your sheet name
    
    ' Set the range to loop through (Columns A, B, and C from A1 to C2000)
    Set rng = ws.Range("A1:C2000")
    
    For Each cell In rng
        If Not IsEmpty(cell.Value) And cell.Font.Bold Then ' Check if the cell value is bold and not blank
            ' Split the cell value by spaces to handle multiple bold words within the same cell
            Dim words() As String
            words = Split(cell.Value, " ")
            
            ' Add a semicolon before each bold word
            For i = LBound(words) To UBound(words)
                If cell.Characters(Start:=InStr(cell.Value, words(i)), Length:=Len(words(i))).Font.Bold Then
                    words(i) = ";" & words(i)
                End If
            Next i
            
            ' Join the modified words back into the cell
            cell.Value = Join(words, " ")
        End If
    Next cell
End Sub

字符串