HTML到Excel格式转换 – 在同一单元格中的break和li

我在本周早些时候发布了一个关于 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>

在多行上显示的示例输出(希望在一个单元格中显示多行 – 类似于shift输入的方式)

Here are some possible uses:



Syntax highlighting code snippets

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

*styling email addresses and tags*

解决方法

我不确定你是否可以这样做(我可能是错的).但如果只是你的数据被覆盖的问题,那么这里是另一种选择:)

逻辑：不是将其粘贴在同一工作表中,而是将其粘贴到临时工作表中,然后复制这些行并将其插入工作表1中,以便不覆盖数据.查看快照.

快照：

码：

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