Excel2016无TEXTJOIN时按序检索匹配替换文本关键词的实现方法

针对版本限制、输出顺序要求，以下是两个可直接落地的实现路径，其中VBA方案修正了原有基础匹配代码按映射表顺序输出的逻辑缺陷。

方案1：VBA实现（高适配性，严格按原文顺序输出） #

原有基础匹配代码的核心问题是：遍历映射表时只要匹配到关键词就直接追加结果，输出顺序完全由映射表的排列顺序决定，和关键词在原文中的实际出现位置无关。
修正逻辑为：

• 逐行处理待匹配文本时，先记录所有匹配到的关键词在原文中的起始位置、对应的替换值
• 对记录的匹配项按起始位置从小到大排序
• 按排序后的顺序拼接替换值作为最终输出

可直接运行的VBA代码 #

Sub 按原文顺序输出匹配结果()
    Dim wsMap As Worksheet, wsData As Worksheet
    Dim mapArr As Variant, dataArr As Variant
    Dim resultArr() As String
    Dim i As Long, j As Long, k As Long, pos As Integer
    Dim matchRecord() As Variant, recordCount As Long
    Dim tempPos As Variant, tempVal As Variant
    
    ' 绑定工作表（可根据实际表名修改）
    Set wsMap = ThisWorkbook.Sheets("Sheet1")
    Set wsData = ThisWorkbook.Sheets("Sheet2")
    
    ' 读取映射表数据（默认从第2行开始，跳过表头，范围为A列非空单元格）
    mapArr = wsMap.Range("A2:B" & wsMap.Cells(wsMap.Rows.Count, "A").End(xlUp).Row).Value
    ' 读取待处理文本数据（默认从第2行开始，跳过表头，范围为A列非空单元格）
    dataArr = wsData.Range("A2:A" & wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row).Value
    
    ReDim resultArr(1 To UBound(dataArr), 1 To 1)
    
    For i = 1 To UBound(dataArr)
        recordCount = 0
        ReDim matchRecord(1 To UBound(mapArr), 1 To 2)
        
        ' 遍历所有映射关键词，记录匹配位置
        For j = 1 To UBound(mapArr)
            If Trim(mapArr(j, 1)) <> "" Then
                ' 查找关键词在当前文本中的起始位置，默认不区分大小写
                pos = InStr(1, dataArr(i, 1), mapArr(j, 1), vbTextCompare)
                If pos > 0 Then
                    recordCount = recordCount + 1
                    matchRecord(recordCount, 1) = pos
                    matchRecord(recordCount, 2) = mapArr(j, 2)
                End If
            End If
        Next j
        
        ' 对匹配记录按起始位置升序排序
        If recordCount > 1 Then
            For j = 1 To recordCount - 1
                For k = j + 1 To recordCount
                    If matchRecord(j, 1) > matchRecord(k, 1) Then
                        ' 交换位置和对应值
                        tempPos = matchRecord(j, 1)
                        matchRecord(j, 1) = matchRecord(k, 1)
                        matchRecord(k, 1) = tempPos
                        
                        tempVal = matchRecord(j, 2)
                        matchRecord(j, 2) = matchRecord(k, 2)
                        matchRecord(k, 2) = tempVal
                    End If
                Next k
            Next j
        End If
        
        ' 拼接排序后的结果，默认用逗号分隔
        resultStr = ""
        For j = 1 To recordCount
            If resultStr <> "" Then resultStr = resultStr & ", "
            resultStr = resultStr & matchRecord(j, 2)
        Next j
        resultArr(i, 1) = resultStr
    Next i
    
    ' 结果一次性写入Sheet2的B列
    wsData.Range("B2").Resize(UBound(resultArr), 1).Value = resultArr
    MsgBox "全部行处理完成"
End Sub

使用注意事项 #

• 匹配默认不区分大小写，需要严格区分的话，将InStr参数中的vbTextCompare替换为vbBinaryCompare
• 结果拼接默认用逗号分隔，可根据需求修改为顿号、空格等其他分隔符
• 若需要整词匹配（即文本中连续字符拼接成的衍生词不触发匹配），可在位置判断环节增加边界校验逻辑

方案2：Excel 2016 兼容纯公式实现 #

由于2016版本无TEXTJOIN函数，纯公式方案需要通过辅助列逐次截断文本，逐轮提取最先匹配到的关键词，最终按顺序拼接结果，操作步骤为：

1. 在Sheet1中选中A2:B列所有非空映射行，在名称框（编辑栏左侧的输入框）输入自定义名称MapRange
2. 在Sheet2的C2单元格输入数组公式（输入完成后按Ctrl+Shift+Enter三键确认，适配2016版本），计算当前行文本中所有匹配关键词的最小出现位置：
   =MIN(IF(INDEX(MapRange,0,1)<>"",IF(ISNUMBER(SEARCH(INDEX(MapRange,0,1),A2)),SEARCH(INDEX(MapRange,0,1),A2),LEN(A2)+1),LEN(A2)+1))
3. 在D2单元格输入数组公式，根据最小位置提取对应的替换值：
   =IFERROR(INDEX(MapRange, MATCH(C2, IF(ISNUMBER(SEARCH(INDEX(MapRange,0,1),A2)), SEARCH(INDEX(MapRange,0,1),A2),0),0),2),"")
4. 在E2单元格输入公式，截掉已匹配的文本片段，作为下一轮匹配的源文本：
   =MID(A2, C2 + LEN(INDEX(MapRange, MATCH(D2, INDEX(MapRange,0,2),0),1)), LEN(A2))
5. 将C2:E2的公式向右拖动足够多的列（覆盖单行文本最多的关键词数量即可），最后将所有对应行的D列单元格值用&符号连接，即可得到按原文顺序排列的替换值拼接结果

• 该方案的局限性是数据量大时计算效率较低，适合关键词数量少、文本长度短的场景

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