我正试图从以下网站提取有关NFL新兵的数据:
http://espn.go.com/college-sports/football/recruiting/rankings/_/class/2013
我需要访问每个位置并将信息粘贴/提取到Excel电子表格中。正如您在下面所看到的,每个位置的URL的唯一区别是VARIABLE大写。我需要这个VARIABLE来改变从运动员到角卫到宽接收器。
http://espn.go.com/college-sports/football/recruiting/playerrankings/_/position/VARIABLE/class/2013/view/position
以下是我正在使用的代码:
Dim array_example(18) As String
Sub Macro1()
array_example(0) = "athlete"
array_example(1) = "cornerback"
array_example(2) = "defensive-end"
array_example(3) = "defensive-tackle"
array_example(4) = "fullback"
array_example(5) = "inside-linebacker"
array_example(6) = "kicker"
array_example(7) = "offensive-center"
array_example(8) = "offensive-guard"
array_example(9) = "outside-linebacker"
array_example(10) = "offensive-tackle"
array_example(11) = "quarterback-dual-threat"
array_example(12) = "quarterback-pocket-passer"
array_example(13) = "running-back"
array_example(14) = "safety"
array_example(15) = "tight-end-h"
array_example(16) = "tight-end-y"
array_example(17) = "wide-receiver"
For i = 0 To 17
LastUsedRow = ActiveSheet.Range("A1").Offset(Sheet1.Rows.Count - 1, 0).End(xlUp).Row
LastEmptyRow = LastUsedRow + 1
Cell = "A" & LastEmptyRow
With ActiveSheet.QueryTables.Add(Connection:="URL;http://espn.go.com/college-sports/football/recruiting/playerrankings/_/position/" & array_example(i) & "/class/2013/view/position" & "", Destination:=Range("" & Cell & ""))
.Name = "s"
.FieldNames = True
.RowNumbers = True
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertEntireCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlAllTables
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = False
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=True
End With
Next i
End Sub
我的问题是,每次运行此代码时,excel都会卡住(有一个小圆盘继续为光标旋转)。当我按Escape停止代码时,我发现只有一个位置已复制到Excel电子表格中。您能否请一看我的代码并让我知道我可以更改它以循环所有位置并将所有信息(一个接一个)复制到电子表格中?
非常感谢。
答案 0 :(得分:4)
当我第一次运行代码时,我获得了与您描述的相同的体验。我等了大约2分钟并杀死了这个过程,发现只有前100个装了。
我进去并将此行更改为false
,以便我可以看到它正在加载。
.Refresh BackgroundQuery:=False
我还在Next i
之前添加了一个调试行,这样我就能看到它是否实际遍历了所有地址。
End With
Debug.Print "next " & i
Next i
现在,当我运行它时,它只用了大约30秒钟就完成了所有18个地址。 excel中超过3000行的结果。
然后我添加了一个简单的计时器,看看每个步骤花了多长时间。这次总共花了12秒。
next 0 - 0 seconds
next 1 - 1 seconds
next 2 - 1 seconds
next 3 - 1 seconds
next 4 - 0 seconds
next 5 - 0 seconds
next 6 - 3 seconds
next 7 - 1 seconds
next 8 - 0 seconds
next 9 - 1 seconds
next 10 - 0 seconds
next 11 - 0 seconds
next 12 - 2 seconds
next 13 - 1 seconds
next 14 - 0 seconds
next 15 - 0 seconds
next 16 - 1 seconds
next 17 - 0 seconds
Total Time: 12
接下来,将backgroundQuery更改回true。计时器在不到1秒的时间内全部计数18次,只显示前100个结果。就像excel在设置所有连接之前运行代码所以它只有足够的时间来设置第一个。
所以,我建议只将背景查询设置为false。每次尝试的时间都在12到30秒之间。
在这里你可以看到它通过外接收器一路走来。
NESTED LOOP QUESTION
将外部循环写为年份循环。所以在For i = 0 To 17
添加之前:
For x = 2006 to 2013
For i = 0 To 17
'...continue your code
' Change With line to this:
With ActiveSheet.QueryTables.Add(Connection:="URL;http://espn.go.com/college-sports/football/recruiting/playerrankings/_/position/" & array_example(i) & "/class/" & CStr(x) & "/view/position" & "", Destination:=Range("" & Cell & ""))
'...continue your code
Next i
Next x
End Sub
答案 1 :(得分:0)
您的代码运行正常。也许你有一个慢/没有互联网连接来获取数据。
这就是它的样子
我得到100个WR。如果我第一次运行循环并且我停止它我得到100 ATH。
看起来你的for循环正在运行并将你的QueryTable
放在一行中然后在数据填充之前将下一个放在它下面的一行,可能会覆盖它。我会将每一个放在一个单独的工作表中。