我有一份情况清单。一列中包含160个excel中的超链接。我正在尝试从这些单独的链接中提取数据。以便导航到特定页面(例如https://www.oddschecker.com/golf/canadian-open/winner/bet-history/dustin-johnson)。
注意:出于测试目的,代码的范围很小。
我认为最好的过程是:
对于链接2,单击并打开每个单独的超链接并拉取information
我在编写代码时遇到了麻烦,这些代码将单击并随后从一个链接循环到下一个链接,例如从单元格A6到单元格A7。
我尝试过使用涉及.click操作的For each循环。
不幸的是,我还没有在上述方面取得任何成功。
如果能提供一些帮助,或者如果有人能给我指出进一步调查的方向,我将不胜感激。
Public Sub GetReleaseTimes()
Dim ie As Object, hTable As HTMLTable, clipboard As Object, ws2 As Worksheet, ws1 As Worksheet, URL As Range
Set ws2 = ThisWorkbook.Worksheets("Sheet2")
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set ie = CreateObject("InternetExplorer.Application")
Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
With ie
.Visible = True
.navigate2
For Each URL In ws1.Range("A6:A10").Click
While .Busy Or .readyState < 4: DoEvents: Wend
Set hTable = .document.querySelector(".eventTable")
clipboard.SetText hTable.outerHTML
clipboard.PutInClipboard
ws2.Range("A1").PasteSpecial
Next
.Quit
End With
End Sub
发布于 2019-06-05 03:17:08
请不要单击超链接打开浏览器进行抓取。将链接读入一个数组,循环该数组,并对每个url执行.navigate2。
此外,当你从剪贴板粘贴时,你需要找到最后使用的行,而不管列是什么,然后在每一次旋转下面粘贴一到两行。
Option Explicit
Public Sub GetReleaseTimes()
Dim ie As Object, hTable As HTMLTable, clipboard As Object
Dim ws2 As Worksheet, ws1 As Worksheet, urls()
Set ws2 = ThisWorkbook.Worksheets("Sheet2")
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set ie = CreateObject("InternetExplorer.Application")
Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
urls = Application.Transpose(ws1.Range("A6:A10").Value)
With ie
.Visible = True
For i = LBound(urls) To UBound(urls)
.Navigate2 urls(i)
While .Busy Or .readyState < 4: DoEvents: Wend
Set hTable = .document.querySelector(".eventTable")
clipboard.SetText hTable.outerHTML
clipboard.PutInClipboard
ws2.Range("A" & GetLastRow(ws2) + 2).PasteSpecial
Next
.Quit
End With
End Sub
Public Function GetLastRow(ByVal sh As Worksheet) As Long
On Error Resume Next
GetLastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
https://stackoverflow.com/questions/56445651
复制相似问题