试图从网站提取数据到Excel。 For循环不工作
我正试图从以下网站提取关于NFL新兵的数据：
http://espn.go.com/college-sports/football/recruiting/rankings/_/class/2013 我需要访问每一个位置，并复制粘贴/提取信息到Excel电子表格。 正如您在下面看到的，这些位置的URL的唯一区别是大写的VARIABLE。 我需要这个VARIABLE从运动员转angular到广angular接收器。
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电子表格中。 你可以看看我的代码，让我知道我可以改变它，以遍历所有的职位，并复制所有的信息（一个接一个）到电子表格？
万分感谢。
当我第一次运行代码时，我有和你所描述的一样的经验。 我等了大约2分钟，杀死了这个进程，发现只有第一个100加载的地方。
我进去把这一行改为false以便我能看到它加载。
.Refresh BackgroundQuery:=False
我也Next i一个之前添加了一个debugging行，所以我可以看看它是否实际遍历所有地址。
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在所有连接被设置之前通过代码运行一样，所以它只有足够的时间来设置第一个连接。
所以，我build议只设置背景查询为false。 每次我尝试了12到30秒。
在这里你可以看到，它通过广泛的接收器。
巢环问题
将外部循环写为年份循环。 所以之前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
你的代码工作正常。 也许你有一个缓慢/没有互联网连接来获取数据。
这是它的样子
我收到了100个WR。 如果我第一次运行循环，我停下来，我得到100 ATH。
看起来你的for循环正在运行，把你的QueryTable放在一行中，然后在数据填满之前把下一行放在它下面一行，可能会覆盖它。 我会把每个在一个单独的工作表，而不是。