- 帖子
- 4901
- 主題
- 44
- 精華
- 24
- 積分
- 4916
- 點名
- 98
- 作業系統
- Windows 7
- 軟體版本
- Office 20xx
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-4-30
- 最後登錄
- 2024-4-27
              
|
回復 2# seemee - Sub 個股交易明細下載()
- Dim 股票代號 As String, 年 As String, 月 As String, N As Name, i As Integer, T As Integer, A
- 年 = 2013
- 月 = 1
- 月 = Format(月, "00")
- 股票代號 = 2330
-
- T = Time
- With ActiveSheet
- .Cells.Clear
- DoEvents
- 'Application.ScreenUpdating = False
- 'Application.StatusBar = False
- With .QueryTables.Add(Connection:="URL;http://www.twse.com.tw/ch/trading/exchange/STOCK_DAY/genpage/Report" & 年 & 月 & "/" & 年 & 月 & "_F3_1_8_" & 股票代號 & ".php?STK_NO=" & 股票代號 & "&myear=" & 年 & "&mmon=" & 月, Destination:=Range("A1"))
- .BackgroundQuery = True
- .WebTables = "8"
- .Refresh BackgroundQuery:=False
- ActiveSheet.Names(.Name).Delete
- End With
- 月 = 2
-
- Do
- 月 = Format(月, "00")
- .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Select
- With .QueryTables.Add(Connection:="URL;http://www.twse.com.tw/ch/trading/exchange/STOCK_DAY/genpage/Report" & 年 & 月 & "/" & 年 & 月 & "_F3_1_8_" & 股票代號 & ".php?STK_NO=" & 股票代號 & "&myear=" & 年 & "&mmon=" & 月, Destination:=Selection)
- .BackgroundQuery = True
- .WebTables = "8"
- On Error Resume Next
- Do
- Err.Clear
- .Refresh BackgroundQuery:=False
- If Err.Number = 1004 Then GoTo 10 '無法開啟檔案就跳到下一月
- Loop Until Err.Number = 0
- On Error GoTo 0
- If Application.CountA(.ResultRange) = 0 Then GoTo OUT
- .ResultRange.Rows("1:2").Delete '刪除1:2列
- ActiveSheet.Names(.Name).Delete
- 10
- 月 = 月 + 1
- End With
- Loop Until 月 > 12
- OUT:
- .[A1].Select
- Application.ScreenUpdating = True
- With .UsedRange
- .WrapText = False
- .Interior.ColorIndex = xlNone
- .Font.Size = 12
- .Columns.AutoFit
- A = CreateObject("WScript.Shell").popup("共下載 " & i & " 頁費時 " & Format(Time - T, "hh:mm分SS秒"), 5, 年 & "_" & 股票代號, 48 + 0)
- Application.StatusBar = 年 & " _ " & 股票代號 & " 共下載 " & i & "頁 費時 " & Format(Time - T, "HH:MM:SS")
- End With
- For Each N In .Names
- N.Delete
- Next
- End With
- End Sub
|
|
發表於 2013-5-16 23:07
| 