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

我在本周早些时候发布了一个关于HTML转换为Excel的问题，这个问题对我很好。 我给出的示例macros代码在将HTML代码转换为Excel单元格的过程中做了很好的工作（感谢Siddharth Rout！）。 我现在遇到的问题，似乎无法find任何地方的答案与IE对象如何处理段落，中断，并在Excel中列出项目。 p，br和li将文本移动到原始单元格下面的单元格中，覆盖这些单元格中的所有数据。 有什么办法让HTML块只显示在一个单元格中（意思是每个新的行标签只会在同一个单元格中创build一个新行）？

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 + Enter的工作方式）

 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

我不确定你是否可以做到这一点（ 我可能是错的 ）。 但如果这只是你的数据被覆盖的问题，那么这里是一个替代scheme:)

LOGIC：不是将其粘贴在同一张纸上，而是将其粘贴到临时工作表中，然后复制这些行并将其插入到sheet1中，这样数据就不会被覆盖。 看快照。

快照：

码：

 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