excel选中表格英文符号全部替换为中文符号，同时将数字格式修改为Times New Roman

专为编办设计，一键将选中表格英文符号全部替换为中文符号，同时将数字格式修改为Times New Roman。

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
                
                newText = originalText
                Dim key As Variant
                For Each key In punctMap.Keys
                    newText = Replace(newText, key, punctMap(key))
                Next key
                
                cell.Value = newText
                
                ' 恢复字符级格式，并为数字设置 Times New Roman
                For i = 1 To Len(newText)
                    If i <= UBound(charFormats) Then
                        With cell.Characters(i, 1).Font
                            If IsNumeric(Mid(newText, i, 1)) Then
                                .Name = "Times New Roman"
                            Else
                                .Name = charFormats(i)(2)
                            End If
                            .Bold = charFormats(i)(0)
                            .Italic = charFormats(i)(1)
                            .Size = charFormats(i)(3)
                            .Color = charFormats(i)(4)
                        End With
                    End If
                Next i
            End If
        End If
    Next cell
End Sub