台灣最大程式設計社群網站
線上人數
953
 
會員總數:241341
討論主題:186910
歡迎您免費加入會員
討論區列表 >> office VBA / WinOS >> 請問有關迴圈問題EXCEL VBA
[ 變換順序 ]  
[我要回覆]
1
回應主題 加入我的關注話題 檢舉此篇討論 將提問者加入個人黑名單
請問有關迴圈問題EXCEL VBA
價值 : 50 QP  點閱數:353 回應數:1

樓主

石世宜
門外漢
0 1
12 1
發送站內信

請問怎麼用迴圈方式把下面程式碼減肥

這個是要抓取外部資料的程式碼,本來是土法煉鋼但程式碼太長我還切成3個資料更新按鈕,我的想法是要抓取2464股票的股本資料,先事先建立一個名稱為2464的活頁簿,開起巨集的時候,程式先開起2464的分頁,將網址http://easyfun.concords.com.tw/z/zc/zcb/zcb_2464.djhtm 中WebTables = "2"
的資料存到範圍A166到G220的地方.
下面那個3050的資料也是依照這樣方法,但重複程式碼的複製貼上,股票數量如果超過100支程式碼會太長.
程式碼之中除了
1.分頁中的2464
2.網址中的2464
3.Name = "zcb_2464.djhtm_1" 中的2464是會變的,其他部份都是固定.
不知道可不可以改成自動讀取工作表一 A欄位的股票代號,自動把資料抓到對應的各分頁的固定位置上

Private Sub CommandButton11_Click()
Sheets("2464").Select
Sheets("2464").Range("A166:G220").Select
Selection.ClearContents


With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://easyfun.concords.com.tw/z/zc/zcb/zcb_2464.djhtm", Destination:= _
Sheets("2464").Range("$A$166"))
.Name = "zcb_2464.djhtm_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "2"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Sheets("3105").Select
Sheets("3105").Range("A166:G220").Select
Selection.ClearContents


With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://easyfun.concords.com.tw/z/zc/zcb/zcb_3105.djhtm", Destination:= _
Sheets("3105").Range("$A$166"))
.Name = "zcb_3105.djhtm_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "2"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Sheets("9951").Select
Sheets("9951").Range("A166:G220").Select
Selection.ClearContents


With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://easyfun.concords.com.tw/z/zc/zcb/zcb_9951.djhtm", Destination:= _
Sheets("9951").Range("$A$166"))
.Name = "zcb_9951.djhtm_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "2"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With





搜尋相關Tags的文章: [ VAB ] , [ 迴圈 ] , [ 理財 ] , [ 抓外部資料 ] ,
本篇文章發表於2017-01-02 19:00
別忘捐VP感謝幫助你的人 新手會員瞧一瞧
1樓
作者回應

石世宜
檢舉此回應
結果自己研究出來了....
Sub 抓股本資料()
Dim ID As String

For i = 2 To 2000

If Range("A" & i).Value <> "" Then
ID = Range("A" & i).Value
Sheets(ID).Select
Sheets(ID).Range("A1:G90").Select
Selection.ClearContents


With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://easyfun.concords.com.tw/z/zc/zcb/zcb_" & ID & ".djhtm", Destination:= _
Sheets(ID).Range("$A$1"))

.WebFormatting = xlWebFormattingNone
.WebTables = "2"

.Refresh BackgroundQuery:=False

End With
End If
Next

End Sub
本篇文章回覆於2017-01-05 08:57
== 簽名檔 ==
--未登入的會員無法查看對方簽名檔--
[ 變換順序 ]   
1

回覆
如要回應,請先登入.