簡體   English   中英

將多行文本單元格從字表復制到 Excel 單元格

[英]Copying multiple line text Cell from Word Table to Excel Cell

我想出了如何將單元格直接從 Word 表復制到 Excel 單元格。

Word 中的單元格可能包含通過按 Enter 分隔的多行。 所以你有一行,按回車,下一行等等。

我想完全按照 Excel 的樣子復制它。 當我復制它時,整個字符串是 Excel 單元格中的一行。

第一個捕獲來自 Word,下一個是 Excel 單元。

在此處輸入圖像描述

在此處輸入圖像描述

下面是復制到第一列的代碼。 不需要 rest。 我在 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 單元。

首先,請確保在您正在寫入的單元格上啟用了“換行文本”選項,否則即使它們存在於文本中,它也不會正確顯示換行符。

在此處輸入圖像描述

既然這已被清除,那么您的代碼沒有保留 Word 表中的換行符有兩個不同的原因。 首先是您使用的是 CLEAN function。 第二個是使用 VBA 從 Word 表中傳遞數據的方式存在問題(一些信息丟失)。 幸運的是,有一些方法可以解決這些問題。

避免使用 CLEAN function

當您使用 CLEAN function 時,您會從文本字符串中刪除所有不可打印的字符。 問題是您在 Word 表中看到的“格式”實際上是由 2 個不可打印字符(或至少其中一個)的存在引起的。 這些字符是回車 (CR) 和換行 (LF) 字符。 通過使用 CLEAN function,您要求刪除那些刪除指示換行符信息的字符。

所以我嘗試在沒有 CLEAN function 的情況下和你一樣做,並制作了一個 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 function: 來消除那些垃圾字符 go 了! 如果只有一個開箱即用的 VBA function 來刪除那些不可打印的字符而不從字符串中刪除 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

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM