Как объединить несколько ячеек с помощью VBA

Question

У меня есть некоторые проблемы с Excel и VBA, в которых не знаю, много знаний.Я скопировал текст из PDF, и это ужасно.У меня есть клетки, которые содержат текст.Проблема в том, что текст из одного абзаца разбит на несколько ячеек.В начале каждого абзаца слово, выделенное жирным шрифтом (например, CLR. ), описывает остальную часть текста.Таким образом, он определяет, где должен начинаться каждый абзац.Как я могу объединить эти ячейки в одну?

Я вижу

Я хочу

Answer 1

Sub MergeText()

    Dim strMerged$, r&, j&, i&

    r = 1
    Do While True
        If Cells(r, 1).Characters(1, 1).Font.Bold Then
            strMerged = "": strMerged = Cells(r, 1)
            r = r + 1
            While (Not Cells(r, 1).Characters(1).Font.Bold) And Len(Cells(r, 1)) > 0
                strMerged = strMerged & Cells(r, 1)
                r = r + 1
            Wend
            i = i + 1: Cells(i, 2) = strMerged
            Cells(i, 2).Characters(1, InStr(1, strMerged, ".", vbTextCompare)).Font.Bold = True
        Else
            Exit Do
        End If
    Loop

End Sub

Answer 2

Измените (если необходимо) и попробуйте:

Option Explicit

Sub test()

    Dim LastRow As Long, i As Long, j As Long, Count As Long
    Dim str As String

    With ThisWorkbook.Worksheets("Sheet1") 'Change sheet name if needed

        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        For i = LastRow To 2 Step -1

            If (UCase(Left(.Range("A" & i), 1)) <> Left(.Range("A" & i), 1)) And UCase(Left(.Range("A" & i - 1), 1)) = Left(.Range("A" & i - 1), 1) Then

                Count = 0

                For j = 1 To Len(.Range("A" & i - 1))

                    If .Range("A1").Characters(j, 1).Font.FontStyle = "Bold" Then
                        Count = Count + 1
                    Else
                        Exit For
                    End If

                Next j

                str = .Range("A" & i - 1).Value & " " & .Range("A" & i).Value

                With .Range("A" & i - 1)
                    .Value = str
                    .Font.Bold = False

                    With .Characters(Start:=1, Length:=Count).Font
                        .FontStyle = "Bold"
                    End With

                End With

                .Rows(i).EntireRow.Delete

            ElseIf (UCase(Left(.Range("A" & i), 1)) <> Left(.Range("A" & i), 1)) And UCase(Left(.Range("A" & i - 1), 1)) <> Left(.Range("A" & i - 1), 1) Then

                str = .Range("A" & i - 1).Value & " " & .Range("A" & i).Value

                With .Range("A" & i - 1)
                    .Value = str
                    .Font.Bold = False
                End With

                .Rows(i).EntireRow.Delete

            End If

        Next i

    End With

End Sub