中日环境Excel VBA必看:3个致命坑+1套万能解决方案

中日环境Excel VBA必看：3个致命坑+1套万能解决方案

大家好👋

‍

日常工作中，很多朋友都会用 Excel VBA 做品目匹配、数量汇总，但一遇到中文系统 ↔ 日文系统混用，马上就崩：

明明品目一样，B 列却全是 0
日文系统一跑就编译报错
保存再打开，代码直接消失

今天这篇，把根源 + 可直接复制的代码 + 一键操作一次性讲透，中日环境通用，再也不踩坑！

🚨 你是不是也遇到这 3 个崩溃问题？

品目匹配全 0A列、E列品目肉眼一模一样（比如 377304），汇总后 B 列全是 0。
日文系统编译报错中文写好的代码，到日文系统提示：「修正候補: ステートメントの最後」，直接跑不起来。
代码保存后消失辛辛苦苦写好 VBA，关了再开，代码、按钮全没了。

🔍 3 个问题的真正根源

隐藏空格搞鬼全角空格、不间断空格、零宽空格……Trim 清不掉，字典匹配失败。
中日文字符乱码中文变量名、注释在日文 VBA 里乱码 → 直接报语法错。
文件格式错了.xlsx 不支持宏！保存成 .xlsx → 代码自动被删掉。必须存 .xlsm！

✅ 终极解决方案：中日通用 VBA 代码

我把代码全部改成英文结构，搭配正则清空所有空格，中文、日文系统都能稳定跑。

直接复制下面代码即可使用 👇

Option Explicit'==========================================================================' 功能：品目代码匹配 + 数量汇总（中日双语环境兼容）'==========================================================================Sub MatchItemCodeAndSum()    '===================== 【这里自己改】=====================    Const SHEET_NAME      As String = "Sheet1"    Const DATA_START_ROW  As Integer = 2    Const COL_A_ITEM      As Integer = 1    Const COL_B_RESULT    As Integer = 2    Const COL_E_ITEM      As Integer = 5    Const COL_F_QTY       As Integer = 6    '=========================================================    Dim ws As Worksheet    Dim lastRow As Long    Dim i As Long    Dim dict As Object    Dim reg As Object    Dim aKey As String, eKey As String    Dim fValue As Double    On Error GoTo ErrorHandler    ' 工作表判断    Set ws = ThisWorkbook.Worksheets(SHEET_NAME)    If ws Is Nothing Then        MsgBox "工作表不存在：" & SHEET_NAME, vbCritical        Exit Sub    End If    ' 正则：清理所有空格/不可见字符    Set reg = CreateObject("VBScript.RegExp")    reg.Global = True    reg.IgnoreCase = True    reg.Pattern = "[\s\u3000\u00a0\u2000-\u200b\u0009\u000d\u000a]"    ' 字典：品目 → 数量汇总    Set dict = CreateObject("Scripting.Dictionary")    dict.CompareMode = vbTextCompare    ' B列格式重置，避免不显示    ws.Columns(COL_B_RESULT).NumberFormat = "General"    ws.Columns(COL_B_RESULT).ClearContents    ' 取最后一行    lastRow = ws.Cells(ws.Rows.Count, COL_A_ITEM).End(xlUp).Row    If ws.Cells(ws.Rows.Count, COL_E_ITEM).End(xlUp).Row > lastRow Then        lastRow = ws.Cells(ws.Rows.Count, COL_E_ITEM).End(xlUp).Row    End If    If lastRow < DATA_START_ROW Then        MsgBox "没有有效数据", vbExclamation        GoTo Cleanup    End If    ' Step1：遍历 E 列，构建汇总字典    For i = DATA_START_ROW To lastRow        eKey = RegexClean(ws.Cells(i, COL_E_ITEM).Value, reg)        fValue = IIf(IsError(ws.Cells(i, COL_F_QTY).Value) Or Not IsNumeric(ws.Cells(i, COL_F_QTY).Value), 0, CDbl(ws.Cells(i, COL_F_QTY).Value))        If eKey <> "" Then            If dict.Exists(eKey) Then                dict(eKey) = dict(eKey) + fValue            Else                dict(eKey) = fValue            End If        End If    Next i    ' Step2：遍历 A 列，匹配填回 B 列    For i = DATA_START_ROW To lastRow        aKey = RegexClean(ws.Cells(i, COL_A_ITEM).Value, reg)        ws.Cells(i, COL_B_RESULT).Value = IIf(dict.Exists(aKey), dict(aKey), 0)    Next i    MsgBox "✅ 处理完成！" & vbCrLf & "处理行数：" & lastRow - DATA_START_ROW + 1, vbInformationCleanup:    Set reg = Nothing    Set dict = Nothing    Set ws = Nothing    Exit SubErrorHandler:    MsgBox "❌ 错误：" & Err.Description, vbCritical    GoTo CleanupEnd Sub'==========================================================================' 正则清洗：清除所有空白字符'==========================================================================Private Function RegexClean(v As Variant, reg As Object) As String    Dim s As String    If IsEmpty(v) Or IsError(v) Then        RegexClean = ""        Exit Function    End If    s = CStr(v)    s = reg.Replace(s, "")    s = Trim(s)    RegexClean = CStr(s)End Function