設迴圈

518587

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

下載次數: 6

2014-10-20 17:25

以下是我匯入的第一個網址的外部資料

1. ' 擷取網路資料
   
2. 
   
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

複製代碼

許瑞祥

你的程式碼是不是沒有複製完整  怎麼會沒有第一行 "sub"

518587

回復 2# 許瑞祥


    對!!! 還缺

1. Sub 巨集1()
   
2. '
   
3. ' 巨集1 巨集
   
4. '
   
5. ' 快速鍵: Ctrl+q

複製代碼

luhpro

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

以 ...
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

回復 4# luhpro


    請問大大能否詳細說明一下 因為我剛入門 還不太懂 感謝

luhpro

回復 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 ' 迴圈結束

許瑞祥

回復 1# 518587

1. Sub test1()
   
2. 
   
3.     Dim a As String           '設定a變數為字串
   
4.     Dim i As Integer          '跑迴圈
   
5.    
   
6.     For i = 2 To 6            '跑回圈  因為你有五個網址   所以是從2跑到6 五次
   
7. 
   
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

複製代碼

迴圈1test.rar (15.56 KB)

程式碼在裡面
下載次數: 5

2014-10-21 10:42