VBA如何在工作簿内容变更时自动替换字符重音符号

原代码问题排查 #

• Intersect参数错误：Intersect方法要求传入两个或以上Range对象，原代码传入行号、列号两个数值，返回值永远为Nothing，替换逻辑直接终止
• Replace语法错误：参数顺序写反且语法不完整，无法执行替换操作
• 未禁用事件触发：修改单元格值会再次触发Worksheet_Change事件，造成递归运行，可能导致Excel卡顿或崩溃
• 仅支持单个单元格处理：批量粘贴内容时只会处理第一个选中单元格，无法覆盖批量输入场景
• On Error Resume Next吞掉所有报错，无法定位问题点

修复后可用代码 #

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 关闭事件防止递归触发
    Application.EnableEvents = False
    Dim rng As Range, cell As Range
    ' 定义重音字符替换规则，可按需扩展
    Dim replaceDict As Object
    Set replaceDict = CreateObject("Scripting.Dictionary")
    replaceDict.Add "ó", "o"
    replaceDict.Add "Ó", "O"
    replaceDict.Add "á", "a"
    replaceDict.Add "Á", "A"
    replaceDict.Add "é", "e"
    replaceDict.Add "É", "E"
    replaceDict.Add "í", "i"
    replaceDict.Add "Í", "I"
    replaceDict.Add "ú", "u"
    replaceDict.Add "Ú", "U"
    replaceDict.Add "ñ", "n"
    replaceDict.Add "Ñ", "N"
    
    On Error GoTo ErrHandler
    
    ' 匹配当前修改的单元格范围
    Set rng = Intersect(Target, Me.UsedRange)
    If Not rng Is Nothing Then
        For Each cell In rng
            ' 跳过公式单元格
            If Left(cell.Formula, 1) <> "=" Then
                Dim cellVal As String, i As Long
                cellVal = cell.Value
                ' 遍历规则替换所有重音字符
                For i = 0 To replaceDict.Count - 1
                    cellVal = Replace(cellVal, replaceDict.keys()(i), replaceDict.items()(i))
                Next i
                ' 原需求转大写，不需要可删除该行
                cellVal = UCase(cellVal)
                cell.Value = cellVal
            End If
        Next cell
    End If
    
ErrHandler:
    ' 无论是否出错都重新开启事件，避免后续宏失效
    Application.EnableEvents = True
End Sub

使用说明 #

• 代码需要放置在对应工作表的代码模块中：右键工作表标签→查看代码，粘贴到打开的VBA编辑器窗口即可
• 重音替换规则可按需在replaceDict字典中新增键值对，键为要替换的重音字符，值为替换后的普通字符
• 若不需要转大写逻辑，删除cellVal = UCase(cellVal)这行即可

内容的提问来源于stack exchange，提问作者BadRobot