Baru saja mendaftarkan akun di sini, dan ya saya benar-benar noob - tolong bersikap baiklah kepada saya. Sekarang untuk tantangan saya: Saya sedang membangun scraper web di VBA & telah menemukan kode yang saya ubah sedikit sesuai kebutuhan saya. Semuanya bekerja dengan sempurna dan sebenarnya cukup mulus. Sekarang saya ingin teks saya yang dimuat ke dalam dokumen exel saya tidak panjang, tetapi lebar. Saya menduga itu ada hubungannya dengan ".Offset (I, j)". Saya telah memainkannya sedikit, tetapi saya hanya berhasil merusak segalanya. Ini kode saya yang saya gunakan:

Dim IE As InternetExplorer
Dim htmldoc As MSHTML.IHTMLDocument 'Document object
Dim eleColtr As MSHTML.IHTMLElementCollection 'Element collection for tr tags
Dim eleColtd As MSHTML.IHTMLElementCollection 'Element collection for td tags
Dim eleRow As MSHTML.IHTMLElement 'Row elements
Dim eleCol As MSHTML.IHTMLElement 'Column elements
Dim ieURL As String 'URL

'Open InternetExplorer
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
'Navigate to webpage
ieURL = "#"
IE.Navigate ieURL
'Wait
Do While IE.Busy Or IE.ReadyState <> 4
 DoEvents
Loop
Set htmldoc = IE.Document 'Document webpage
Set eleColtr = htmldoc.getElementsByTagName("tr") 'Find all tr tags
'This section populates Excel
I = 0 'start with first value in tr collection
For Each eleRow In eleColtr 'for each element in the tr collection
 Set eleColtd = htmldoc.getElementsByTagName("tr")(I).getElementsByTagName("td") 'get all the td elements in that specific tr
 j = 0 'start with the first value in the td collection
 For Each eleCol In eleColtd 'for each element in the td collection
 Sheets("Sheet1").Range("A1").Offset(I, j).Value = eleCol.innerText 'paste the inner text of the td element, and offset at the same time
 j = j + 1 'move to next element in td collection
 Next eleCol 'rinse and repeat
 I = I + 1 'move to next element in td collection
Next eleRow 'rinse and repeat

End Sub ```
1
Blomman 19 April 2020, 20:31

2 jawaban

Jawaban Terbaik

Anda tidak memerlukan peramban. Anda dapat menggunakan xhr lebih cepat. Ambil tabel dan lingkari baris lalu kolom yang mengisi array ukuran sebelumnya (pastikan untuk menghapus baris di mana header berada. Mereka dapat diidentifikasi memiliki [colspan='2'] di td pertama mereka). Kemudian transpos array dan tulis ke sheet.

Option Explicit

Public Sub TransposeTable()
    Dim xhr As MSXML2.XMLHTTP60, html As MSHTML.HTMLDocument, table As MSHTML.htmltable
    'required VBE (Alt+F11) > Tools > References > Microsoft HTML Object Library ;  Microsoft XML, v6 (your version may vary)

    Set xhr = New MSXML2.XMLHTTP60
    Set html = New MSHTML.HTMLDocument
    '  7NXBG2 ;  8QT2E3

    With xhr
        .Open "GET", "https://www.chrono24.com/watch/8QT2E3", False
        .send
        html.body.innerHTML = .responseText
    End With

    Set table = html.querySelector(".specifications table")

    Dim results(), rowCountToExclude As Long

    rowCountToExclude = html.querySelectorAll(".specifications table [colspan='2']").Length
    ReDim results(1 To table.rows.Length - rowCountToExclude, 1 To table.getElementsByTagName("tr")(0).Children(0).getAttribute("colspan"))

    Dim r As Long, c As Long, outputRow As Long, outputColumn As Long, html2 As MSHTML.HTMLDocument

    Set html2 = New MSHTML.HTMLDocument

    For r = 0 To table.getElementsByTagName("tr").Length - 1
        Dim row As Object

        Set row = table.getElementsByTagName("tr")(r)
        html2.body.innerHTML = "<body> <table>" & row.outerHTML & "</table></body> "

        If html2.querySelectorAll("[colspan='2']").Length = 0 Then
            outputRow = outputRow + 1: outputColumn = 1
            For c = 0 To row.getElementsByTagName("td").Length - 1
                results(outputRow, outputColumn) = row.getElementsByTagName("td")(c).innerText
                outputColumn = outputColumn + 1
            Next
        End If
        Set row = Nothing
    Next

    results = Application.Transpose(results)
    ActiveSheet.Cells(1, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
End Sub
2
QHarr 20 April 2020, 05:25

Oke jadi ketika saya mencoba menggunakan langkah yang sama tetapi saya mengubah url halaman yang sama, mis: "https://www.chrono24.com/rolex/mens-air-king-date--5700-very-good -condition-mens-watch--id12873580.htm". saya mendapatkan kesalahan mengemudi "9" - mengapa?

"results(outputRow, outputColumn) = row.getElementsByTagName("td")(c).innerText" - kesalahan

0
Blomman 19 April 2020, 19:29