Есть ли способ написать макрос, который будет l oop, чтобы объединить текст в несколько строк данных в Excel?

Question

Например, мне нужно объединить текст в каждой из этих строк, но документ состоит из тысяч строк, поэтому макрос будет идеальным. Часть, на которой я застрял, заключается в том, что я не знаю, как написать оператор if в al oop, который будет связывать тексты в абзаце, а затем переходить к следующему абзацу строк и делать то же самое до тех пор, пока конец листа. Вы заметите, что каждый из них специально выделен пустой строкой между ними. Любые предложения о том, как это сделать? Пример в ячейке G2 - это то, как я хочу, чтобы каждое начальное предложение выглядело.

Answer 1

использование SpecialCells() метод Range объект

Sub TextJoin()
    Dim area As Range

    With Worksheets("MySheetName") ' change "MySheetName" to your actual sheet name
        For Each area In .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)).SpecialCells(XlCellType.xlCellTypeConstants).Areas
            .Cells(area(1, 1).Row, "G").Value = Join(Application.Transpose(area.Value))
        Next
    End With
End Sub

Answer 2

Попробуйте,

Sub test()
    Dim vDB
    Dim Ws As Worksheet
    Dim vR() As Variant
    Dim i As Long, n As Long

    Set Ws = ActiveSheet
    vDB = Ws.UsedRange
    n = UBound(vDB, 1)
    ReDim vR(1 To n)

    For i = 1 To n
        If vDB(i, 1) = "" Then
            vR(i) = vbCrLf & vbCrLf '
        Else
            vR(i) = vDB(i, 1)
        End If
    Next i
    Sheets.Add
    Range("a1") = Join(vR, " ")
End Sub

Answer 3

"Я бы не хотел вручную вводить формулу для каждого из абзацев в оригинальном документе"

Просто для демонстрации вы можете использовать TEXTJOIN функциональность в VBA с использованием Evaluate(). Большая часть этого кода основана на действительно тонком и коротком решении @HTH: -;

Sub TxtJoin()
    Dim area As Range
    With Sheet1       ' << change to your current sheet's Code(Name)
        For Each area In .Range("A4", .Cells(.Rows.Count, 1).End(xlUp)).SpecialCells(XlCellType.xlCellTypeConstants).Areas
            .Cells(area(1, 1).Row, "G").Value = Evaluate("TEXTJOIN("" "",FALSE," & area.Address & ")")
        Next
    End With
End Sub

Если вы хотите, вы можете добавить формулы, заменив присваивание ячеек на

.Cells(area(1, 1).Row, "G").Formula2 = "=TEXTJOIN("" "",FALSE," & area.Address & ")"