VBA中是否有高效方法可批量合并多个文本替换操作？

本次优化核心解决两个维护痛点：新增替换规则不需要新增独立Replace语句，新增单位映射不需要补写Case分支，后续迭代只需要更新规则集合即可，无需修改核心逻辑。

优化思路 #

• 将所有「待替换文本-目标文本」对存入二维数组，按替换顺序循环执行操作，后续新增规则直接往数组内加条目即可
• 用字典存储单位映射关系，开启不区分大小写匹配，省去同个单位写三种大小写的冗余代码，新增映射直接加字典条目即可
• 移除冗余中间变量，全程只用一个变量存储处理中的文本，降低不必要的内存开销

优化后代码 #

Function Unit(Req_Header As String) As String
    Dim processedStr As String
    processedStr = AkeFind(Req_Header)
    
    ' 替换规则数组，后续新增规则直接按格式加在数组内即可，注意按替换优先级排序
    Dim replaceRules
    replaceRules = Array( _
        Array("formaat_papier_", ""), _
        Array("motief_", ""), _
        Array("materiaal_", ""), _
        Array("vorm_", ""), _
        Array("_", " "), _
        Array("•", "-") _
    )
    
    ' 循环执行批量替换
    Dim i As Long
    For i = LBound(replaceRules) To UBound(replaceRules)
        processedStr = Replace(processedStr, replaceRules(i)(0), replaceRules(i)(1))
    Next
    
    ' 单位映射字典，默认不区分大小写，新增映射直接加对应条目即可
    Dim unitMap As Object
    Set unitMap = CreateObject("Scripting.Dictionary")
    unitMap.CompareMode = vbTextCompare
    
    unitMap("CENTIMETER") = "cm"
    unitMap("MILLIMETER") = "mm"
    unitMap("METER") = "m"
    unitMap("CENTILITER") = "cl"
    unitMap("MILLILITER") = "ml"
    unitMap("LITER") = "l"
    unitMap("KILOGRAM") = "kg"
    unitMap("MILLIGRAM") = "mg"
    unitMap("GRAM") = "g"
    unitMap("PIECE") = "Stuks"
    unitMap("plastic") = "Kunststof"
    unitMap("kunstof") = "Kunststof"
    unitMap("metaal") = "Metaal"
    unitMap("staal") = "Metaal"
    
    ' 匹配映射返回结果，无匹配则返回处理后的原文本
    If unitMap.Exists(processedStr) Then
        Unit = unitMap(processedStr)
    Else
        Unit = processedStr
    End If
End Function

后续维护说明 #

• 新增替换规则：直接在replaceRules数组中按Array("待替换旧文本", "替换为新文本")的格式新增即可，注意优先放更长的前缀类替换规则，再放通用符号类替换规则，避免提前替换字符导致前缀匹配失效
• 新增单位映射：直接在字典初始化后按unitMap("单位名") = "目标值"的格式新增即可，不需要区分输入文本的大小写

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