如何用VBA实现Excel两列多行对应文本拼接（含单元格内多行文本）

针对你遇到的多行文本拼接问题，我们可以通过拆分每行文本→对应行拼接→重新组合多行的思路来解决。以下是完整的VBA实现方案，支持自定义分隔符，还可以通过选项对话框调整设置：

完整VBA代码 #

Option Explicit

' 直接使用默认设置拼接（分隔符为空格）
Sub Ampersander()
    Call Concatenate_Formula(False, False)
End Sub

' 弹出选项对话框，允许自定义分隔符等设置
Sub Ampersander_Options()
    Call Concatenate_Formula(False, True)
End Sub

' 核心拼接逻辑
Private Sub Concatenate_Formula(useFormula As Boolean, showOptions As Boolean)
    Dim ws As Worksheet
    Dim inputCol1 As Range, inputCol2 As Range, outputCol As Range
    Dim separator As String
    Dim maxLines As Integer
    Dim lines1() As String, lines2() As String
    Dim resultLines() As String
    Dim i As Integer, rowNum As Long
    
    ' 默认分隔符为空格
    separator = " "
    
    ' 如果显示选项对话框，让用户自定义分隔符
    If showOptions Then
        separator = InputBox("请输入拼接时的分隔符（默认是空格）：", "拼接选项", separator)
        ' 处理用户取消输入的情况
        If separator = "" Then Exit Sub
    End If
    
    ' 让用户选择要处理的两列和输出列
    On Error Resume Next
    Set inputCol1 = Application.InputBox("请选择第一列数据（单个单元格即可）：", "选择输入列1", Type:=8)
    If inputCol1 Is Nothing Then Exit Sub
    Set inputCol2 = Application.InputBox("请选择第二列数据（单个单元格即可）：", "选择输入列2", Type:=8)
    If inputCol2 Is Nothing Then Exit Sub
    Set outputCol = Application.InputBox("请选择输出列（单个单元格即可）：", "选择输出列", Type:=8)
    If outputCol Is Nothing Then Exit Sub
    On Error GoTo 0
    
    Set ws = inputCol1.Worksheet
    ' 获取两列的有效数据行数（取较大值）
    Dim lastRow1 As Long, lastRow2 As Long
    lastRow1 = ws.Cells(ws.Rows.Count, inputCol1.Column).End(xlUp).Row
    lastRow2 = ws.Cells(ws.Rows.Count, inputCol2.Column).End(xlUp).Row
    Dim totalRows As Long
    totalRows = IIf(lastRow1 > lastRow2, lastRow1, lastRow2)
    
    ' 遍历每一行处理
    For rowNum = 1 To totalRows
        ' 获取当前行的两个单元格文本
        Dim text1 As String, text2 As String
        text1 = ws.Cells(rowNum, inputCol1.Column).Value
        text2 = ws.Cells(rowNum, inputCol2.Column).Value
        
        ' 拆分文本为行数组（兼容Windows和Mac的换行符）
        lines1 = Split(Replace(text1, vbLf, vbCrLf), vbCrLf)
        lines2 = Split(Replace(text2, vbLf, vbCrLf), vbCrLf)
        
        ' 确定最大行数，避免遗漏内容
        maxLines = IIf(UBound(lines1) > UBound(lines2), UBound(lines1), UBound(lines2))
        ReDim resultLines(0 To maxLines)
        
        ' 对应行拼接
        For i = 0 To maxLines
            Dim line1 As String, line2 As String
            line1 = IIf(i <= UBound(lines1), lines1(i), "")
            line2 = IIf(i <= UBound(lines2), lines2(i), "")
            ' 拼接当前行，避免开头/结尾多余分隔符
            resultLines(i) = Trim(line1 & " " & separator & " " & line2)
            resultLines(i) = Replace(resultLines(i), "  ", " ") ' 去除多余空格
        Next i
        
        ' 将拼接后的行重新组合为多行文本
        ws.Cells(rowNum, outputCol.Column).Value = Join(resultLines, vbCrLf)
    Next rowNum
    
    MsgBox "多行文本拼接完成！", vbInformation, "操作成功"
End Sub

使用说明 #

1. 打开你的Excel文件，按下Alt + F11打开VBA编辑器；
2. 右键点击左侧的工作簿名称，选择「插入」→「模块」；
3. 将上述代码粘贴到模块窗口中；
4. 返回Excel界面，按下Alt + F8，选择以下宏之一运行：
   • Ampersander：直接使用默认空格分隔符拼接；
   • Ampersander_Options：弹出对话框让你自定义分隔符（比如逗号、竖线等）；
5. 按照提示依次选择第一列、第二列和输出列即可完成拼接。

示例效果 #

假设：

• A1单元格内容：

  第一行文本
  第二行文本
  

• B1单元格内容：

  对应第一行
  对应第二行
  对应第三行
  

拼接后输出单元格内容：

第一行文本 对应第一行
第二行文本 对应第二行
 对应第三行

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