Board logo

標題: 設迴圈 [打印本頁]
作者: 518587    時間: 2014-10-20 17:25     標題: 設迴圈

我想要從第一個網址匯入外部資料、第二個網址匯入外部資料.....到第五個，請問我該如何設立一個迴圈?
[attach]19368[/attach]
以下是我匯入的第一個網址的外部資料
  1. ' 擷取網路資料

  3.     Range("C3").Select
  4.     ActiveCell.FormulaR1C1 = _
  5.         "http://www.atpworldtour.com/Tennis/Players/Ac/R/Ricardo-Acioly.aspx"
  6.     Sheets("擷取資料").Select
  7.     Range("A1").Select
  8.     With ActiveSheet.QueryTables.Add(Connection:= _
  9.         "URL;http://www.atpworldtour.com/Tennis/Players/Ac/R/Ricardo-Acioly.aspx", _
  10.         Destination:=Range("$A$1"))
  11.         .Name = "Ricardo-Acioly"
  12.         .FieldNames = True
  13.         .RowNumbers = False
  14.         .FillAdjacentFormulas = False
  15.         .PreserveFormatting = True
  16.         .RefreshOnFileOpen = False
  17.         .BackgroundQuery = True
  18.         .RefreshStyle = xlInsertDeleteCells
  19.         .SavePassword = False
  20.         .SaveData = True
  21.         .AdjustColumnWidth = True
  22.         .RefreshPeriod = 0
  23.         .WebSelectionType = xlEntirePage
  24.         .WebFormatting = xlWebFormattingNone
  25.         .WebPreFormattedTextToColumns = True
  26.         .WebConsecutiveDelimitersAsOne = True
  27.         .WebSingleBlockTextImport = False
  28.         .WebDisableDateRecognition = False
  29.         .WebDisableRedirections = False
  30.         .Refresh BackgroundQuery:=False
  31.     End With
複製代碼
作者: 許瑞祥    時間: 2014-10-20 21:28

你的程式碼是不是沒有複製完整  怎麼會沒有第一行 "sub"
作者: 518587    時間: 2014-10-20 21:35

回復 2# 許瑞祥


    對!!! 還缺
  1. Sub 巨集1()
  2. '
  3. ' 巨集1 巨集
  4. '
  5. ' 快速鍵: Ctrl+q
複製代碼
作者: luhpro    時間: 2014-10-20 22:20

我想要從第一個網址匯入外部資料、第二個網址匯入外部資料.....到第五個，請問我該如何設立一個迴圈?

以 ...
518587 發表於 2014-10-20 17:25

Sub nn()
' 擷取網路資料
Dim lRows

lRows = 2
Do While Cells(lRows, 2) <> ""
    Range("C3").Select
    ActiveCell.FormulaR1C1 = Cells(lRows, 2)
    Sheets("擷取資料").Select
    Range("A1").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;" & Cells(lRows, 2), _
...
    End With
Loop
End Sub
作者: 518587    時間: 2014-10-20 22:24

回復 4# luhpro


    請問大大能否詳細說明一下 因為我剛入門 還不太懂 感謝
作者: luhpro    時間: 2014-10-20 23:16

回復 5# 518587
Dim lRows ' 定義 lRows 變數, 做迴圈中列號變動使用
lRows = 2 ' 從第2列開始抓網址
Do While Cells(lRows, 2) <> "" ' Do 迴圈開始, While 符合後面條件就繼續執行迴圈, Cells(列號=lRows, 欄號=2)  儲存格表示方式, <>"" 儲存格內容不等於空字串
    Range("C3").Select
    ActiveCell.FormulaR1C1 = Cells(lRows, 2) ' 網址用儲存格內容取代, 因 lRows 會遞增, 所以每次迴圈抓的網址都不同
    Sheets("擷取資料").Select
    Range("A1").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;" & Cells(lRows, 2), _ '   "URL;網址"  改為  "URL;" & 儲存格內容(即網址), & 為字串連接使用字元
...
    End With
lRows = lRows + 1 ' 請加上這行,上面忘了加, 抱歉.  lRows 每次變動加 1 , 即 第 2 列 ->  第 3 列 -> ...
Loop ' 迴圈結束
作者: 許瑞祥    時間: 2014-10-21 10:42

回復 1# 518587
  1. Sub test1()

  3.     Dim a As String           '設定a變數為字串
  4.     Dim i As Integer          '跑迴圈
  5.    
  6.     For i = 2 To 6            '跑回圈  因為你有五個網址   所以是從2跑到6 五次

  8.         a = Worksheets("工作表2").Range("B" & i)   'i=2 是B2  以此類推 B3   B4   B5   B6
  9.         
  10.         With ActiveSheet.QueryTables.Add(Connection:= _
  11.             "URL;http://www.atpworldtour.com/Tennis/Players/Ac/R/Ricardo-Acioly.aspx", _
  12.             Destination:=Range("$A$1"))   '以下網址是你提供  就不解說
  13.             .Name = "Ricardo-Acioly"
  14.             .FieldNames = True
  15.             .RowNumbers = False
  16.             .FillAdjacentFormulas = False
  17.             .PreserveFormatting = True
  18.             .RefreshOnFileOpen = False
  19.             .BackgroundQuery = True
  20.             .RefreshStyle = xlInsertDeleteCells
  21.             .SavePassword = False
  22.             .SaveData = True
  23.             .AdjustColumnWidth = True
  24.             .RefreshPeriod = 0
  25.             .WebSelectionType = xlEntirePage
  26.             .WebFormatting = xlWebFormattingNone
  27.             .WebPreFormattedTextToColumns = True
  28.             .WebConsecutiveDelimitersAsOne = True
  29.             .WebSingleBlockTextImport = False
  30.             .WebDisableDateRecognition = False
  31.             .WebDisableRedirections = False
  32.             .Refresh BackgroundQuery:=False
  33.         End With
  34.     Next i
  35. End Sub
複製代碼
[attach]19372[/attach]



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)