Excel VBA：遍历DIV内容 – 粘贴到单个单元格中

我在Stack Exchange上find了一些代码，并且能够根据我的需要修改它95％的path，但最后一个问题仍然出现，父DIV中的所有DIV都粘贴到一个单元格中，我希望它们发布到我的工作表中的单个单元格。 代码来自堆栈溢出用户“波特兰亚军”，原始post可以在这里find。 我遇到的HTML看起来像这样：

<div class="right-header"> <div>Entry 1</div> <div>Entry 2</div> <div>Entry 3</div> <div>Entry 4</div> <div>Entry 5</div> <div>Entry 6</div> </div> 

孩子DIV没有ID，类，或样式，只是被一个孤独的DIV标签包围的信息。 这一切都被转储到一个单一的单元格中，而不是将其转储到Al（条目1），B1（条目2），C1（条目3）等中。原始代码如下：

 Sub extract() Dim IE As InternetExplorer Dim html As HTMLDocument Set IE = New InternetExplorerMedium IE.Visible = False IE.Navigate2 "C:\Users\john\Documents\Test.html" ' Wait while IE loading Do While IE.Busy Application.Wait DateAdd("s", 1, Now) Loop Set html = IE.document Set holdingsClass = html.getElementsByClassName("right-header") Dim results As Variant results = Split(holdingsClass(0).textContent, vbLf) cntr = 1 For i = LBound(results) To UBound(results) If Trim(results(i)) <> "" Then Select Case Right(Trim(results(i)), 1) Case "<div>" Range("B" & cntr) = CStr(Trim(results(i))) Case "%" Range("C" & cntr).Value = Trim(results(i)) cntr = cntr + 1 Case 0 Range("C" & cntr).Value = Trim(results(i)) Case Else Range("A" & cntr).Value = Trim(results(i)) End Select End If Next i Sheets("Sheet3").Range("A1").Value = holdingsClass(0).textContent 'Cleanup IE.Quit Set IE = Nothing End Sub 

谢谢大家的帮助！

Answer 1

编译但未经testing：

 Sub extract() Dim IE As InternetExplorer Dim topDiv, div, childDivs, tc As String, cntr Set IE = New InternetExplorerMedium IE.Visible = False IE.Navigate2 "C:\Users\john\Documents\Test.html" ' Wait while IE loading Do While IE.Busy Application.Wait DateAdd("s", 1, Now) Loop Set topDiv = IE.document.getElementsByClassName("right-header")(0) Set childDivs = topDiv.getElementsByTagName("div") cntr = 2 For Each div In childDivs tc = Trim(div.textContent) If tc <> "" Then Select Case Right(tc, 1) Case "<div>" 'not sure whether you should be seeing HTML in textcontent...? Range("B" & cntr) = CStr(tc) Case "%" Range("C" & cntr).Value = tc cntr = cntr + 1 Case 0 Range("C" & cntr).Value = tc Case Else Range("A" & cntr).Value = tc End Select End If Next div Sheets("Sheet3").Range("A1").Value = topDiv.textContent 'Cleanup IE.Quit Set IE = Nothing End Sub