Excel VBA: Iterate Through DIV Содержание - Вставить в отдельные ячейки

Question

Я нашел код на Stack Exchange из всех мест и смог изменить его на 95% пути для моих нужд, но один последний вопрос продолжает возникать, все DIVs в родительском DIV вставляются в одну ячейку, я хочу, чтобы они отправлялись в отдельные ячейки на моем листе. Код пришел от пользователя Stack Overflow «Portland Runner», а исходный пост можно найти here. 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> 

Ребенок DIVs не имеет идентификаторов, классов или стилей, только информацию, окруженную одиноким DIV тегом. Это все сбрасывается в одну ячейку, где я бы хотел, чтобы она была сброшена в Al (Entry 1), B1 (Entry 2), C1 (Entry 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