寻求批量替换多行单元格内容的VBA代码或Excel公式方案

VBA方案（适合大数据量，效率优先） #

用字典预存替换规则，批量处理每个单元格，避免反复遍历整列，大幅提升处理速度。

Sub BatchReplaceWithLineBreaks()
    Dim ws As Worksheet
    Dim replaceDict As Object
    Dim lastRow As Long, i As Long
    Dim cellText As String, textArr() As String
    Dim j As Long
    
    ' 指定目标工作表，替换成你的表名
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set replaceDict = CreateObject("Scripting.Dictionary")
    
    ' 加载替换规则：列C为匹配值，列B为对应替换值
    lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
    For i = 2 To lastRow ' 假设第一行是表头
        ' 若匹配值重复，保留最后一条的替换值；要保留第一条就删除下一行
        replaceDict(ws.Cells(i, "C").Value) = ws.Cells(i, "B").Value
    Next i
    
    ' 处理列A的多行单元格
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    For i = 2 To lastRow
        cellText = ws.Cells(i, "A").Value
        If cellText <> "" Then
            ' 按换行符拆分单元格内容
            textArr = Split(cellText, vbLf)
            ' 逐个匹配替换
            For j = LBound(textArr) To UBound(textArr)
                If replaceDict.Exists(textArr(j)) Then
                    textArr(j) = replaceDict(textArr(j))
                End If
            Next j
            ' 合并回带换行的文本，可修改列标（如"D"）避免覆盖原数据
            ws.Cells(i, "A").Value = Join(textArr, vbLf)
        End If
    Next i
    
    Set replaceDict = Nothing
    MsgBox "替换完成"
End Sub

使用说明 #

1. 按Alt+F11打开VBA编辑器，插入新模块；
2. 粘贴代码，修改工作表名称、列范围（若匹配/替换列不是B/C，对应调整）；
3. 运行宏等待完成。

公式方案（无需宏，适合小到中等数据量） #

用TEXTJOIN结合FILTERXML拆分多行内容，配合XLOOKUP实现替换，保留原有换行格式。

假设：

• A列是待处理的多行单元格
• B列是替换后的值
• C列是需要匹配的内容
• 结果输出到D列

在D2单元格输入公式，下拉填充：

=TEXTJOIN(CHAR(10), TRUE, IFERROR(XLOOKUP(FILTERXML("<t><s>"&SUBSTITUTE(A2, CHAR(10), "</s><s>")&"</s></t>", "//s"), $C$2:$C$100, $B$2:$B$100, FILTERXML("<t><s>"&SUBSTITUTE(A2, CHAR(10), "</s><s>")&"</s></t>", "//s")), FILTERXML("<t><s>"&SUBSTITUTE(A2, CHAR(10), "</s><s>")&"</s></t>", "//s")))

公式解释 #

1. SUBSTITUTE(A2, CHAR(10), "</s><s>")：将换行符替换为XML标签，实现内容拆分；
2. FILTERXML(...)：把拆分后的内容转为数组；
3. XLOOKUP(...)：匹配数组中每个元素，找到对应替换值，未匹配到则保留原内容；
4. TEXTJOIN(CHAR(10), TRUE, ...)：用换行符将替换后的数组重新合并为多行文本。

注意事项 #

• Excel 2019及更早版本无TEXTJOIN和XLOOKUP，可替换为VLOOKUP+数组公式（需按Ctrl+Shift+Enter确认）；
• 大数据量下公式效率低于VBA，优先选择VBA方案。

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