- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
15#
發表於 2012-8-1 15:14
| 只看該作者
回復 10# lalalada
.WebTables = "4,""table2"""
修改9#如下- Option Explicit
- Sub 個股交易明細下載()
- Dim 股票代號 As String, N As Name, i As Integer, T As Date, A
- Do While 股票代號 = ""
- 股票代號 = InputBox("股票代號", "輸入查詢之股票代號", "1101")
- If 股票代號 = "" Then End
- Loop
- T = Time
- With ActiveSheet
- .Cells.Clear
- DoEvents
- Application.ScreenUpdating = False
- Application.StatusBar = False
- With .QueryTables.Add(Connection:="URL;http://bsr.twse.com.tw/bshtm/bsContent.aspx?StartNumber=" & 股票代號 & "&FocusIndex=1", Destination:=Range("A1"))
- .WebFormatting = xlWebFormattingNone
- .WebTables = "4,""table2"""
- .Refresh BackgroundQuery:=False
- If Application.CountA(.ResultRange) = 0 Then
- MsgBox "股票代號:" & 股票代號 & " 錯誤 !!!"
- [a1].Select
- End
- End If
- ActiveSheet.Names(.Name).Delete
- End With
- i = 2
- Do
- .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Select
- With .QueryTables.Add(Connection:="URL;http://bsr.twse.com.tw/bshtm/bsContent.aspx?StartNumber=" & 股票代號 & "&FocusIndex=" & i, Destination:=Selection)
- .WebFormatting = xlWebFormattingNone
- .WebTables = "table2"
- On Error Resume Next
- Do
- Err.Clear
- .Refresh BackgroundQuery:=False
- Loop Until Err.Number = 0
- On Error GoTo 0
- If Application.CountA(.ResultRange) = 0 Then GoTo OUT
- .ResultRange(1).EntireRow.Delete
- ActiveSheet.Names(.Name).Delete
- i = i + 1
- End With
- Loop
- OUT:
- .[a1].Select
- Application.ScreenUpdating = True
- .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")
- For Each N In .Names
- N.Delete
- Next
- End With
- End Sub
|
|
發表於 2012-8-1 14:05
| 
