垂直合并单元格中的文本答案

【问题标题】：Combine text in cells vertically垂直合并单元格中的文本
【发布时间】：2019-06-20 19:25:41
【问题描述】：

有人在 Excel 中创建了一个文本文档，就像在打字机上一样。他们写到屏幕的末尾，然后按回车键。

我想将每个段落放入它自己的单元格中，然后复制并粘贴到 Word。

我尝试录制宏，但它卡在段落之间（作者在段落之间跳过了一行）。我的研究显示一次连接一个单元格，这对我处理大约 1000 行文本没有帮助。

VBA 类似于：

' If cell below isn't empty
' then
' activecell=activecell&activecell(0,1)
' delete activecell(0,1)
' else activecell(0,2).select
'endif
'loop 1000 times

如果当前文档说：

A boy walked down
the street.

Next he tried
to run.

Finally this task
was over.

之后的样子：

A boy walked down the street.

Next he tried to run.

Finally this task was over.

【问题讨论】：

标签： excel vba

【解决方案1】：

假设我的假设是正确的，请尝试以下操作：

将所有内容复制到 Word。
对两个回车符 (^p^p) 执行查找/替换并将它们替换为占位符字符串（例如：%%%%%，只要它不在您的文档中，任何操作都可以）
对单个回车符 (^p) 执行查找/替换并将其替换为单个空格 ()
为您的占位符字符串（在我上面的示例中为%%%%%）执行查找/替换，并将其替换为两个回车符（^p^p）
您可能需要对双空格进行查找/替换，然后将其替换为单空格。

在校对和一些调整之后，你应该完成了。

【讨论】：

谢谢！那让我发疯了。我很感激！为我节省了几个小时的手动操作时间！
我曾经不得不定期做这个，所以我变成了一个我保存在本地模板中的宏！

【解决方案2】：

另一种选择

Sub compileDoc()
    Dim textArr(), r As Long, n As Long, curPar As String

    textArr = Sheet1.Range("A2:A" & Sheet1.Range("A" & Rows.Count).End(xlUp).Row).Value
    n = LBound(textArr)
    For r = LBound(textArr) To UBound(textArr)
        If Len(textArr(r, 1)) Then
            curPar = curPar & " " & textArr(r, 1)
            textArr(r, 1) = ""
        Else
            textArr(n, 1) = WorksheetFunction.Trim(curPar)
            n = n + 1
            curPar = ""
        End If
    Next r
    textArr(n, 1) = curPar
    Sheet1.Range("B2:B" & n + 1) = textArr
End Sub

【讨论】：

【解决方案3】：

附加选项，运行宏后可以从即时窗口复制文本。您可以通过 VBA 开发人员窗口中的 View 或 Ctrl+G 访问它。

Sub Concatenate_Text()
Dim i As Long
Dim lastrow As Long
Dim paragraph As String

Dim wb As Workbook
Dim ws As Worksheet

Set wb = ThisWorkbook
Set ws = wb.Worksheets("Sheet1")

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

For i = 1 To lastrow
    If IsEmpty(ws.Cells(i, "A")) = False Then
    paragraph = paragraph & " " & ws.Cells(i, "A").Value & " " & ws.Cells(i + 1, "A").Value
    i = i + 1
    Else: paragraph = paragraph & vbCrLf
    End If

Next i

Debug.Print paragraph

End Sub

【讨论】：