将多行文本单元格从 Word 表复制到 Excel 单元格

Question

我想出了如何将单元格直接从 Word 表格复制到 Excel 单元格。

Word 中的单元格可能包含通过按 Enter 分隔的多行。所以你有一行，按回车，下一行等等。

我想完全按照它在 Excel 中的样子复制它。当我复制它时，整个字符串是 Excel 单元格中的一行。

第一个捕获来自 Word，下一个是 Excel 单元格。

下面是复制到第一列的代码。其余的都不需要。我在 Outlook 中工作，这就是我使用 Excel 库和 Word 库的原因。该代码将使用 Word 文档抓取电子邮件。

With wrd.Tables(1)
    xlSht.Cells(j, 1).Value = WorksheetFunction.Clean(.Cell(2, 2).Range.Text)
    xlSht.Cells(j, 2).Value = WorksheetFunction.Clean(.Cell(3, 2).Range.Text)
    xlSht.Cells(j, 4).Value = Atmt.FileName
End With

我尝试使用一些逻辑拆分 Excel 单元格，但很难检测到需要在哪里输入。
注意：所有文本中都不会使用“and”。它会有所不同，所以我不能用它来拆分 Excel 单元格。

Answer 1

首先，请确保单元格上启用了“自动换行”选项 您正在写信，否则它不会正确显示换行符，即使 它们存在于文本中。

既然这已被清除，那么您的代码没有保留 Word 表中的换行符有两个不同的原因。首先是您正在使用 CLEAN 功能。第二个是使用 VBA 从 Word 表中传递数据的方式存在问题（一些信息丢失）。幸运的是，有一些方法可以解决这些问题。

避免使用 CLEAN 功能

当您使用 CLEAN 功能时，您会从文本字符串中删除所有不可打印的字符。问题是您在 Word 表中看到的“格式”实际上是由 2 个不可打印字符（或至少其中一个）的存在引起的。这些字符是回车 (CR) 和换行 (LF) 字符。通过使用 CLEAN 功能，您要求删除那些删除指示换行符的信息的字符。

所以我尝试在没有 CLEAN 功能的情况下做和你一样的事情，并制作了一个 Word 表格

然后我使用以下代码将第一个单元格的内容写入 Excel。

Sub ReadFromWordTable()

Dim WordApp As Word.Application
Set WordApp = GetObject(, "Word.Application")

Dim WordDoc As Word.Document
Set WordDoc = WordApp.ActiveDocument

Dim xlSht As Worksheet
Set xlSht = ActiveSheet

Dim TempString As String

With WordDoc.Tables(1)
    TempString = .Range.Text
End With

xlSht.Cells(1, 1).Value2 = TempString

'StringDrillDown TempString

End Sub

并且看到换行符没有出现（我们稍后会回到这个）并且在我的单元格末尾有一些垃圾字符。

现在我明白你为什么使用 CLEAN 功能了：让那些垃圾字符消失！如果有一个开箱即用的 VBA 函数来删除那些不可打印的字符而不从字符串中删除 CR 和 LF！

由于没有任何字符并且它们只出现在末尾，我建议使用以下代码简单地清理TempString，这将删除从右侧开始的所有不可打印字符并立即停止遇到可打印的字符。

    Dim i As Long, NbOfCharacter As Long
    NbOfCharacter = Len(TempString)
    
    For i = Len(TempString) To 1 Step -1
        If Asc(Mid(TempString, i, 1)) < 32 Then
            NbOfCharacter = NbOfCharacter - 1
        Else
            Exit For
        End If
    Next
    
    TempString = Left(TempString, NbOfCharacter)

请注意，我使用的是Asc function。它返回唯一标识字符的扩展 ASCII（又名 ANSI）字符代码（从 1 到 255 的数字）。在我们的例子中，所有不可打印的字符都返回一个低于 32 的值，因此我们可以轻松地将它们过滤掉。

确保您写入单元格的字符串中存在换行符

正如你看到的，当我们直接使用.Range.Text 的值时，换行符没有正确通过。为了理解这个问题，我们可能想要深入研究构成 TempString 变量的不同字符。为此，您可以使用这样的程序：

Sub StringDrillDown(str As String)

    Dim ws As Worksheet
    With ActiveWorkbook
        Set ws = .Sheets.Add(AFTER:=.Sheets(.Sheets.Count))
    End With

    ws.Range("A1") = "Character"
    ws.Range("B1") = "Ascii Code"
    Dim i As Long
    For i = 1 To Len(str)
        ws.Cells(i + 1, 1).Value2 = Mid$(str, i, 1)
        ws.Cells(i + 1, 2).Value2 = Asc(Mid$(str, i, 1))
    Next i

End Sub

给我们这个：

我们注意到，“and”和“some”之间的唯一字符是对应于 CR 的字符编号 13（这似乎是字符串数据在 Word 和 Excel 之间传输的一种怪癖）。因此，我们缺少了向 Excel 表明我们想要在这两个单词之间换行所需的 LF。

要解决这个问题，我们可以使用以下方法：

    With WordDoc.Tables(1)
        TempString = Replace(.Cell(1, 1).Range.Text, Chr(13), Chr(13) & Chr(10))
    End With

此代码将用 CRLF 替换所有单独的 CR（请注意，LF 的字符代码是 10）。

注意事项：如果字符串中已经存在 CRLF 字符，则上面的代码行会将它们加倍，但此处并非如此。

最后，我们的初始代码示例如下：

Sub ReadFromWordTable()

    Dim WordApp As Word.Application
    Set WordApp = GetObject(, "Word.Application")
    
    Dim WordDoc As Word.Document
    Set WordDoc = WordApp.ActiveDocument
    
    Dim xlSht As Worksheet
    Set xlSht = ActiveSheet
    
    Dim TempString As String
    
    With WordDoc.Tables(1)
        TempString = Replace(.Cell(1, 1).Range.Text, Chr(13), Chr(13) & Chr(10))
    End With
    
    Dim i As Long, NbOfCharacter As Long
    NbOfCharacter = Len(TempString)
    
    For i = Len(TempString) To 1 Step -1
        If Asc(Mid(TempString, i, 1)) < 32 Then
            NbOfCharacter = NbOfCharacter - 1
        Else
            Exit For
        End If
    Next
    
    TempString = Left(TempString, NbOfCharacter)
    
    xlSht.Cells(1, 1).Value2 = TempString
    
    'StringDrillDown TempString

End Sub