小弟用巨集擷取股票相關資料要貼到excel
當程式執行到最後一個迴圈:
For j = 1 To 18
Cells(18 * (i - 1) + j + 1, 5) = Y
Next
速度非常慢,
想請問有沒有什麼方法可以改善, 謝謝
以下為原程式碼
Sub 損益下載()
' -------------------------------------- 網址陣列宣告 ----------------------------------------------------------
' 計算代碼數量
Application.ScreenUpdating = False
Sheets("清單").Select
V = Range("A2").End(xlDown).Row
'宣告陣列, 代碼,損益表,
Dim Number(), Income_Statement()
ReDim Number(V - 1), Income_Statement(V - 1)
For i = 1 To V - 1
' 股票代碼陣列
Number(i) = Cells(i + 1, 1)
' 損益表網址陣列
Income_Statement(i) = "https://www.cmoney.tw/finance/f00041.aspx?s=" & Number(i) & "&o=4"
Next
' -------------------------------- 損益表下載 -----------------------------------------------------
For i = 1 To V - 1
Sheets("暫存區").Activate ' 下載資料放於暫存區
Cells.Clear
url = Income_Statement(i) ' 損益表網址陣列
Application.DisplayStatusBar = True
Application.ScreenUpdating = False
Set ie = CreateObject("internetexplorer.application") '使用此方式可以免除 "設定引用項目"
With ie
.Visible = False 'True為開啟ie, False為不開啟ie
.Navigate url
Do While .ReadyState 4 Or .Busy '等待網頁開啟
DoEvents
Loop
Application.Wait Now + TimeValue("00:00:10")
.ExecWB 17, 2 'Select All
.ExecWB 12, 2 'Copy selection
Sheets("暫存區").Activate
Sheets("暫存區").Cells(1, 1).Select
ActiveSheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
End With
ie.Quit
' 計算財報公布年份數 Y
Cells.Find(What:="年季").Select
Dim Y As Integer
Y = Selection.End(xlToRight).Column - 1 ' -1, 扣掉"年季"儲存格
' 填入財報年數 Y 值至下載區
Sheets("下載區").Select
For j = 1 To 18
Cells(18 * (i - 1) + j + 1, 5) = Y
Next
End Sub
