Excel VBA：遍歷DIV內容-粘貼到單個單元格中

Question

我在所有地方的Stack Exchange上找到了一些代碼，並能夠按照我的需要進行95％的修改，但是最后一個問題不斷出現，父DIV中的所有DIV都粘貼到一個單元格中，我希望它們發布到我的工作表中的各個單元格。 該代碼來自Stack Overflow用戶“ Portland Runner”，可以在此處找到原始帖子。 我所反對的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

編譯但未經測試：

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