Excel объединяет многострочный текст с многострочным следующим столбцом

Question

У меня есть два длинных столбца, в каждом из которых есть тысячи столбцов. Имеется различная длина многострочного текста. Я могу объединить, если присутствует только одна строка, но как объединить через VBA, когда в одной ячейке есть многострочный текст для соответствующего многострочного текст это можно увидеть как ниже

пример вывода с необработанными данными

Пример файла Файл в формате Excel

Option Explicit
Sub Ampersander()
        Call Concatenate_Formula(False, False)
End Sub

Sub Ampersander_Options()
       Call Concatenate_Formula(False, True)
End Sub

Sub Concatenate()

    Call Concatenate_Formula(True, False)
End Sub

Sub Concatenate_Options()

    Call Concatenate_Formula(True, True)
End Sub


Sub Concatenate_Formula(bConcat As Boolean, bOptions As Boolean)

Dim rSelected As Range
Dim c As Range
Dim sArgs As String
Dim bCol As Boolean
Dim bRow As Boolean
Dim sArgSep As String
Dim sSeparator As String
Dim rOutput As Range
Dim vbAnswer As VbMsgBoxResult
Dim lTrim As Long
Dim sTitle As String


    Set rOutput = ActiveCell
    bCol = False
    bRow = False
    sSeparator = ""
    sTitle = IIf(bConcat, "CONCATENATE", "Ampersand")


    On Error Resume Next
    Set rSelected = Application.InputBox(Prompt:= _
                    "Select cells to create formula", _
                    Title:=sTitle & " Creator", Type:=8)
    On Error GoTo 0


    If Not rSelected Is Nothing Then


        sArgSep = IIf(bConcat, ",", "&")


        If bOptions Then

            vbAnswer = MsgBox("Columns Absolute? $A1", vbYesNo)
            bCol = IIf(vbAnswer = vbYes, True, False)

            vbAnswer = MsgBox("Rows Absolute? A$1", vbYesNo)
            bRow = IIf(vbAnswer = vbYes, True, False)

            sSeparator = Application.InputBox(Prompt:= _
                        "Type separator, leave blank if none.", _
                        Title:=sTitle & " separator", Type:=2)

        End If


        For Each c In rSelected.Cells
            sArgs = sArgs & c.Address(bRow, bCol) & sArgSep
            If sSeparator <> "" Then
                sArgs = sArgs & Chr(34) & sSeparator & Chr(34) & sArgSep
            End If
        Next


        lTrim = IIf(sSeparator <> "", 4 + Len(sSeparator), 1)
        sArgs = Left(sArgs, Len(sArgs) - lTrim)


        If bConcat Then
            rOutput.Formula = "=CONCATENATE(" & sArgs & ")"
        Else
            rOutput.Formula = "=" & sArgs
        End If

    End If

End Sub

Answer 1

Вы можете использовать Split(), чтобы разделить содержимое каждой ячейки на несколько строк, а затем перейти оттуда, как вы можете видеть в Concatenate_Multiline().

Я включил метод Test(), он будет принимать многострочный текст из A1 (первый параметр) и многострочный текст из B1 (2-й параметр) и помещать объединенный результат в C1 (третий параметр).

Sub Test()
    For i = 1 To Rows.Count
        Concatenate_Multiline Range("A" & i), Range("B" & i), Range("C" & i)
    Next i
End Sub

Sub Concatenate_Multiline(cell1 As Range, cell2 As Range, destination As Range)
    Dim lineCell1() As String
    Dim lineCell2() As String
    Dim sResult As String

    lineCell1() = Split(cell1.Formula, vbLf, , vbTextCompare)
    lineCell2() = Split(cell2.Formula, vbLf, , vbTextCompare)

    For i = LBound(lineCell1) To UBound(lineCell1)
        sResult = sResult & lineCell1(i)

        If (i >= LBound(lineCell2)) Then
            If (i <= UBound(lineCell2)) Then
                sResult = sResult & lineCell2(i)

                If (i < UBound(lineCell1)) Then
                    sResult = sResult & vbLf
                End If
            End If
        End If
    Next i

    destination.Formula = sResult
End Sub