HTML to Excel格式轉換 - 在同一單元格中打破和li

Question

我在本週早些時候發佈了一個關於HTML轉換爲Excel的問題，這對我來說很合適。我給出的示例宏代碼在將代碼從HTML格式轉換爲Excel單元方面做得很好（謝謝Siddharth Rout！）。我現在遇到的問題似乎無法在任何地方找到答案，這與IE對象如何處理Excel中的段落，中斷和列表項有關。 p，br和li將文本移動到源單元格下面的單元格中，覆蓋這些單元格中的所有數據。是否有任何方法可以讓HTML塊僅顯示在一個單元格中（意思是每個新行標記只會在同一個單元格中創建一個新行）？

VBA代碼

Sub Sample() 
    Dim Ie As Object 

    Set Ie = CreateObject("InternetExplorer.Application") 

    With Ie 
     .Visible = False 

     .Navigate "about:blank" 

     .document.body.InnerHTML = Sheets("Sheet1").Range("A1").Value 

     .document.body.createtextrange.execCommand "Copy" 
     ActiveSheet.Paste Destination:=Sheets("Sheet1").Range("A1") 

     .Quit 
    End With 
End Sub 

示例HTML

<p> Here are some possible uses:</p> <ul> <li><font color = "red"> syntax highlighting code snippets</font></li> <li style ="font-weight:bold; color: orange">validating credit card numbers, phone numbers, and zip codes</li> <li style = "font-style: italic">styling email addresses and tags</li> </ul> 

樣本輸出正顯示在多行（想在一個小區中，以顯示在多行 - 類似方式轉+進入工作）

Here are some possible uses: 



syntax highlighting code snippets 

**validating credit card numbers, phone numbers, and zip codes** 

*styling email addresses and tags* 

Answer 1

我不確定你是否可以那樣做（我可能是錯的）。但是，如果它只是一個被覆蓋然後在這裏你的數據的問題，是一種替代:)

LOGIC：而是將其粘貼在同一張紙上的，將其粘貼在一個臨時表，然後複製這些行和插入他們在sheet1中，以便您的數據不會被覆蓋。見快照。

快照：

CODE：

Sub Sample() 
    Dim ws As Worksheet, wstemp As Worksheet 
    Dim Ie As Object 
    Dim LastRow As Long 

    Set Ie = CreateObject("InternetExplorer.Application") 

    Set ws = Sheets("Sheet1") 

    '~~> Create Temp Sheet 
    Set wstemp = Sheets.Add 

    With Ie 
     .Visible = True 

     .Navigate "about:blank" 

     '~~> I am assuming that the data is in Cell A1 
     .document.body.InnerHTML = ws.Range("A1").Value 

     '~~> Deleting the row which had the html string. I am assuming that it was in Row 1 
     ws.Rows(1).Delete 

     .document.body.createtextrange.execCommand "Copy" 
     wstemp.Paste Destination:=wstemp.Range("A1") 

     '~~> Find the last row in the temp sheet 
     LastRow = wstemp.Cells.Find(What:="*", After:=wstemp.Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 

     '~~> Copy that data 
     wstemp.Rows("1:" & LastRow).Copy 

     '~~> insert it in Sheet1 
     ws.Rows(1).Insert Shift:=xlDown 

     .Quit 
    End With 

    '~~> Delete Temp sheet 
    Application.DisplayAlerts = False 
    wstemp.Delete 
    Application.DisplayAlerts = True 

End Sub 

HTH