剛剛在這里注冊了一個帳戶，是的，我是一個真正的菜鳥 - 請對我好一點?，F在我面臨的挑戰是：我正在用 VBA 構建一個網絡抓取工具，并找到了一個代碼，我根據自己的需要做了一些修改。一切都很完美，而且實際上非常順利。現在我希望加載到我的 exel 文檔中的文本不要太長，而是很寬。我懷疑它與“.Offset（I，j）”有關。我玩過一點，但我只是設法毀了一切。這是我使用的代碼：Dim IE As InternetExplorerDim htmldoc As MSHTML.IHTMLDocument 'Document objectDim eleColtr As MSHTML.IHTMLElementCollection 'Element collection for tr tagsDim eleColtd As MSHTML.IHTMLElementCollection 'Element collection for td tagsDim eleRow As MSHTML.IHTMLElement 'Row elementsDim eleCol As MSHTML.IHTMLElement 'Column elementsDim ieURL As String 'URL'Open InternetExplorerSet IE = CreateObject("InternetExplorer.Application")IE.Visible = True'Navigate to webpageieURL = "#"IE.Navigate ieURL'WaitDo While IE.Busy Or IE.ReadyState <> 4 DoEventsLoopSet htmldoc = IE.Document 'Document webpageSet eleColtr = htmldoc.getElementsByTagName("tr") 'Find all tr tags'This section populates ExcelI = 0 'start with first value in tr collectionFor 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 collectionNext eleRow 'rinse and repeatEnd Sub ```
1 回答
慕村225694
TA貢獻1880條經驗 獲得超4個贊
你不需要瀏覽器。您可以使用更快的 xhr。抓取表格并循環行，然后循環填充預先確定大小的數組的列（請務必刪除標題所在的行。它們可以被識別為[colspan='2']在第一個中具有td）。然后轉置數組并寫入工作表。
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
- 1 回答
- 0 關注
- 154 瀏覽
添加回答
舉報
0/150
提交
取消