如何使用VBA合并多个单元格

Question

我在excel和VBA方面存在一些问题，因为他们不了解很多知识。我从pdf复制了文本，这很糟糕。 我的单元格包含一些文本。 问题在于，一个段落中的文本被分解为多个单元格。每个段落的开头都有一个粗体字（例如 CLR。​​），它描述了文本的其余部分。因此，它定义了每个段落应从何处开始。我如何将这些单元合并成一个单元？

我看到了

我想要

Answer 1

修改（如果需要）并尝试：

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

Answer 2

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