选中单元格英文符号全部替换为中文（不含.）

将清单中选中单元格英文符号全部替换为中文（不含.）

1.0版本
（逐字浏览，运行效率较低下，没有还原字体，字体可能变化）

Sub 英文符号替换为中文()
        Dim cell As Range
        Dim originalText As String
        Dim char As String
        Dim i As Long
        Dim charFormats() As Variant
        Dim newText As String
        
        ' Define English to Chinese punctuation mappings
        Dim punctMap As Object
        Set punctMap = CreateObject("Scripting.Dictionary")
        punctMap.Add "(", "（"
        punctMap.Add ")", "）"
        punctMap.Add """", "“" ' Opening quote
        punctMap.Add "'", "‘"  ' Single quote
        punctMap.Add ",", "，"
        punctMap.Add ";", "；"
        punctMap.Add ":", "："
        punctMap.Add "?", "？"
        punctMap.Add "!", "！"
        punctMap.Add "<", "〈"
        punctMap.Add ">", "〉"
        
        ' Loop through each selected cell
        For Each cell In Selection
            If Not IsEmpty(cell) Then
                originalText = cell.value
                If Len(originalText) > 0 Then
                    ' Store character-level formatting
                    ReDim charFormats(1 To Len(originalText))
                    For i = 1 To Len(originalText)
                        charFormats(i) = Array( _
                            cell.Characters(i, 1).Font.Bold, _
                            cell.Characters(i, 1).Font.Italic, _
                            cell.Characters(i, 1).Font.FontStyle, _
                            cell.Characters(i, 1).Font.Size, _
                            cell.Characters(i, 1).Font.Color _
                        )
                    Next i
                    
                    ' Replace punctuation while building new text
                    newText = ""
                    For i = 1 To Len(originalText)
                        char = Mid(originalText, i, 1)
                        If punctMap.exists(char) Then
                            newText = newText & punctMap(char)
                        Else
                            newText = newText & char
                        End If
                    Next i
                    
                    ' Apply new text to cell
                    cell.value = newText
                    
                    ' Restore character-level formatting
                    For i = 1 To Len(newText)
                        If i <= UBound(charFormats) Then
                            With cell.Characters(i, 1).Font
                                .Bold = charFormats(i)(0)
                                .Italic = charFormats(i)(1)
                                .FontStyle = charFormats(i)(2)
                                .Size = charFormats(i)(3)
                                .Color = charFormats(i)(4)
                            End With
                        End If
                    Next i
                End If
            End If
        Next cell
    End Sub

2.0优化版
（优化了运行效率，还原了原表格字体）

Sub 英文符号替换为中文()

Dim cell As Range
Dim originalText As String
Dim charFormats() As Variant
Dim newText As String
Dim i As Long

' 定义英文到中文标点的映射
Dim punctMap As Object
Set punctMap = CreateObject("Scripting.Dictionary")
punctMap.Add "(", "（"
punctMap.Add ")", "）"
punctMap.Add """", "“" ' 开引号
punctMap.Add "'", "‘"  ' 单引号
punctMap.Add ",", "，"
punctMap.Add ";", "；"
punctMap.Add ":", "："
punctMap.Add "?", "？"
punctMap.Add "!", "！"
punctMap.Add "<", "〈"
punctMap.Add ">", "〉"

' 遍历选中的每个单元格
For Each cell In Selection
    If Not IsEmpty(cell) Then
        originalText = cell.Value
        If Len(originalText) > 0 Then
            ' 存储字符级格式
            ReDim charFormats(1 To Len(originalText))
            For i = 1 To Len(originalText)
                charFormats(i) = Array( _
                    cell.Characters(i, 1).Font.Bold, _
                    cell.Characters(i, 1).Font.Italic, _
                    cell.Characters(i, 1).Font.Name, _
                    cell.Characters(i, 1).Font.Size, _
                    cell.Characters(i, 1).Font.Color _
                )
            Next i
            
            ' 使用 Replace 进行批量标点替换
            newText = originalText
            Dim key As Variant
            For Each key In punctMap.Keys
                newText = Replace(newText, key, punctMap(key))
            Next key
            
            ' 应用新文本到单元格
            cell.Value = newText
            
            ' 恢复字符级格式
            For i = 1 To Len(newText)
                If i <= UBound(charFormats) Then
                    With cell.Characters(i, 1).Font
                        .Bold = charFormats(i)(0)
                        .Italic = charFormats(i)(1)
                        .Name = charFormats(i)(2)
                        .Size = charFormats(i)(3)
                        .Color = charFormats(i)(4)
                    End With
                End If
            Next i
        End If
    End If
Next cell

End Sub