- 帖子
- 112
- 主題
- 19
- 精華
- 0
- 積分
- 136
- 點名
- 0
- 作業系統
- window
- 軟體版本
- excel
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2013-3-12
- 最後登錄
- 2022-11-29

|
[發問] 此vba走完,整個excel好像lag了,不曉得可以怎樣修改
Sub GGetPrice()
Dim DataQ As Integer, DQQ As Integer, DQ As Integer
Dim StartYear, LastYear, CycleNumber, StockNumber As Integer
StartYear = 2010
LastYear = 2013
CycleNumber = 1
StockNumber = 1101
Sheets("sheet7").Select '清除欲存放的頁面
Cells.Clear
For DP = StartYear To LastYear
Sheets("sheet7").Range("a1").Value = DP
For DQ = 9 To 12
Sheets("sheet6").Select
Cells.Clear '清除抓取資料存放的頁面
[b1] = DQ
[a1] = Sheets("sheet7").Range("a1").Value
If DQ <= 9 Then
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://www.twse.com.tw/ch/trading/exchange/STOCK_DAY/genpage/Report" & [a1] & "0" & [b1] & "/" & [a1] & "0" & [b1] & "_F3_1_8_" & StockNumber & ".php?STK_NO=" & StockNumber & "&myear=" & [a1] & "&mmon=0" & [b1] & "", Destination:=Selection) '新增查詢
Range("a2").Select
.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 = "8"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
'.Refresh BackgroundQuery:=False
'.Name = .ResultRange.Cells(1, 1)
'' 遇到錯誤繼續執行
On Error Resume Next
'' 網頁錯誤會在這行丟出錯誤碼在 Err.Numer 中
.Refresh BackgroundQuery:=False
If Err.Number Then
'' 清除錯誤訊息, 並且回復預設的錯誤處理程序, 繼續跑下一天的資料
Err.Clear
On Error GoTo 0
End If
'' 回復預設的錯誤處理程序
On Error GoTo 0
Worksheets("sheet6").Select
Range("A4:i30").Select
Selection.Copy
Data = 3 + (CycleNumber - 1) * 30
Sheets("sheet7").Select
Range("a" & Data).Select
ActiveSheet.Paste
CycleNumber = CycleNumber + 1
End With
Else
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://www.twse.com.tw/ch/trading/exchange/STOCK_DAY/genpage/Report" & [a1] & "" & [b1] & "/" & [a1] & "" & [b1] & "_F3_1_8_" & StockNumber & ".php?STK_NO=" & StockNumber & "&myear=" & [a1] & "&mmon=" & [b1] & "", Destination:=Selection) '新增查詢
Range("a2").Select
.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 = "8"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
'.Refresh BackgroundQuery:=False
'.Name = .ResultRange.Cells(1, 1)
'' 遇到錯誤繼續執行
On Error Resume Next
'' 網頁錯誤會在這行丟出錯誤碼在 Err.Numer 中
.Refresh BackgroundQuery:=False
If Err.Number Then
'' 清除錯誤訊息, 並且回復預設的錯誤處理程序, 繼續跑下一天的資料
Err.Clear
On Error GoTo 0
End If
'' 回復預設的錯誤處理程序
On Error GoTo 0
Worksheets("sheet6").Select
Range("A7:i37").Select
Selection.Copy
Data = 3 + (CycleNumber - 1) * 30
Sheets("sheet7").Select
Range("a" & Data).Select
ActiveSheet.Paste
CycleNumber = CycleNumber + 1
End With
End If
Next DQ
Next DP
End Sub |
|