- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
22#
發表於 2014-8-12 20:50
| 只看該作者
回復 13# joey0415
給你參考- Option Explicit
- Sub 股票日報表() '查詢單一股票
- Dim 股票代號 As String, 頁數 As String, T As Date
- Do While 股票代號 = ""
- 股票代號 = InputBox("股票代號", "輸入查詢之股票代號", "1101")
- If 股票代號 = "" Then End
- Loop
- T = Time
- 頁數 = 報表頁數(股票代號)
- If 頁數 <> "" Then
- 匯入日報表 股票代號, 頁數
- MsgBox Format(Time - T, "完成 費時 HH:MM:SS")
- Else
- MsgBox "股票代號 " & 股票代號 & " 有誤 !!!"
- End If
- End Sub
- Private Sub 匯入日報表(股票代號 As String, 頁數 As String) '參數傳送來的 --股票代號 & 頁數
- Dim Rng As Range
- With ActiveSheet
- If .QueryTables.Count = 0 Then
- With .QueryTables.Add("URL;about:Tabs", .[A1])
- .Refresh BackgroundQuery:=False
- End With
- End If
- With .QueryTables(1)
- .Connection = "URl;http://bsr.twse.com.tw/bshtm/bsContent.aspx?StartNumber=" & 股票代號 & "&FocusIndex=All_" & 頁數
- .WebFormatting = xlWebFormattingNone
- .WebTables = "4,""table2"""
- .Refresh False
- End With
- Set Rng = .UsedRange.Offset(6)
- With Rng.Columns("A")
- .Replace "序", "=Why", xlWhole
- .SpecialCells(xlCellTypeFormulas, xlErrors).Value = ""
- .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
- End With
- .Cells(1).Select
- End With
- End Sub
- Private Function 報表頁數(股票代號 As String) '參數傳送來的 --股票代號
- With CreateObject("InternetExplorer.Application")
- .Navigate "http://bsr.twse.com.tw/bshtm/bsMenu.aspx"
- Do While .Busy Or .readyState <> 4
- DoEvents
- Loop
- .document.getElementsByName("txtTASKNO").Item(0).Value = 股票代號
- .document.getElementsByName("btnOK")(0).Click
- Do While .Busy Or .readyState <> 4
- DoEvents
- Loop
- 報表頁數 = .document.getElementsByName("sp_ListCount")(0).innertext
- .Quit
- End With
- End Function
|
|
發表於 2014-8-10 16:13
| 
