Excel VBA：DIVの内容を繰り返します。個々のセルに貼り付けます。

Question

Stack Exchangeにいくつかのコードが見つかりました。すべての場所でコードが変更されましたが、私のニーズに合わせて95％修正できました。親DIVのDIVを1つのセルに貼り付け、ワークシートの個々のセルに貼り付けるようにします。コードはStack Overflowユーザーの "Portland Runner"から来ており、元の投稿はhereです。寂しいDIVタグに囲まれた

<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、クラス、またはスタイルを持っていない子供、ちょうど情報：私は反対アップだHTMLは次のようになります。これは、A1（エントリー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