1

Webページから情報を取得しようとしています。私が必要とする情報は表にあり、私はそれに直接対処することができません。これはページです： http ：//www.idealo.de/preisvergleich/MainSearchProductCategory.html？q = matratze

テーブルIDは次のとおりです。必要な各行のplistには「js4offer」という名前があり、テーブル行内から2番目と3番目の「tr」が必要ですが、この行内のすべての要素をループする方法がわかりません。テーブル。私は何千ものコードスニペットを試しましたが、どれも私がやりたいことをしていません;）

これまでの私のコードは次のとおりです。

Sub website()

    Set sht = Sheets("Tabelle4")
    rCount = 1

    Set objIE = CreateObject("InternetExplorer.application")

    With objIE
        .Visible = True
        .Navigate "http://www.idealo.de/preisvergleich/MainSearchProductCategory.html?q=Matratze"

        Do While .Busy Or .ReadyState <> 4
            DoEvents
        Loop

        Set objHTML = objIE.Document
        readText = objHTML.body.outerHTML
        Cells(1, 1) = readText

        Set myElements = objHTML.getElementById("plist")

        For Each ele In myElements

            If ele.getElementsByName("js4offer") Then
                rCount = rCount + 1
                Cells("A", rCount) = ele.Item(1)
                Cells("B", rCount) = ele.Item(2)
            End If

        Next ele

    End With

    objIE.Quit
    Set objIE = Nothing

End Sub
4

1 に答える 1

1

以下のコードを試してください：

参考：表のplistでは、最初のすべてのtrを除いて「js4offer」という名前が付けられています。

Sub website()


' Set sht = Sheets("Tabelle4")
'  rCount = 1

    Dim objIE As Object, objTbl As Object, objTR As Object
    Set objIE = CreateObject("InternetExplorer.application")

    With objIE
        .Visible = True
        .Navigate "http://www.idealo.de/preisvergleich/MainSearchProductCategory.html?q=Matratze"

        Do While .Busy Or .ReadyState <> 4
            DoEvents
        Loop

        Set objTbl = objIE.Document.getElementById("plist")
        Set objTR = objTbl.getElementsbyTagName("tr")


        rCount = 1
        On Error Resume Next
        For Each td In objTR
            Cells(rCount, 1) = td.all(0).innerText
            Cells(rCount, 2) = td.all(1).innerText
            Cells(rCount, 3) = td.all(2).innerText
           ' Cells(rCount, 4) = td.all(3).innerText
            'Cells(rCount, 5) = td.all(4).innerText
            'Cells(rCount, 6) = td.all(5).innerText
            'Cells(rCount, 7) = td.all(6).innerText
            rCount = rCount + 1
        Next
        On Error GoTo 0

    End With

    objIE.Quit
    Set objIE = Nothing

End Sub
于 2013-03-18T17:11:29.570 に答える