- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
回復 5# lalalada
試試看- Option Explicit
- Sub 證交所_買賣交易日報表()
- Dim Stock_NO As String, Sh As Worksheet, URL As String, WB As Workbook
- Do
- Stock_NO = InputBox("股票號碼")
- If Stock_NO = "" Then Exit Sub
- Loop Until Len(Stock_NO) >= 4
- Set Sh = ActiveWorkbook.Sheets.Add
- Application.DisplayAlerts = False
- On Error GoTo Er
- Sh.Name = Stock_NO
- Application.StatusBar = "下載資料中.... "
- Application.ScreenUpdating = False
- URL = "http://bsr.twse.com.tw/bshtm/bsContent.aspx?StartNumber=" & Stock_NO & "&FocusIndex=All_" & 報表頁數(Stock_NO)
- Set WB = Workbooks.Open(URL)
- With WB.Sheets(1)
- If .UsedRange.Count = 1 Then GoTo xOUT '股票沒有資料
- .UsedRange.Columns("A:Q").ClearFormats
- .UsedRange.Columns("B:H").Delete Shift:=xlToLeft
- .UsedRange.Columns("B:B").SpecialCells(xlCellTypeBlanks).Offset(, -1).Delete xlShiftUp
- .UsedRange.Columns("B:E").SpecialCells(xlCellTypeBlanks).Delete xlShiftUp
- .UsedRange.Columns("F:J").SpecialCells(xlCellTypeBlanks).Delete xlShiftUp
- .UsedRange.Columns("F:J").Cut .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
- .Rows("1:2").Delete
- With .UsedRange
- .Value = .Value
- .Sort Key1:=.Range("A2"), Order1:=xlAscending, Header:=xlYes
- .Offset(3).Replace "序", "=XXX", xlWhole
- .SpecialCells(xlCellTypeFormulas, xlErrors).EntireRow.Delete
- End With
- .UsedRange.Copy Sh.[A1]
- Sh.UsedRange.EntireColumn.AutoFit
- End With
- WB.Close False
- Application.ScreenUpdating = True
- Application.StatusBar = False
- Exit Sub
- Er:
- Sheets(Stock_NO).Delete
- Resume
- xOUT:
- WB.Close False
- Sheets(Stock_NO).Delete
- MsgBox "沒有股票 " & Stock_NO
- Application.StatusBar = False
- Application.ScreenUpdating = True
- End Sub
- Private Function 報表頁數(Sstock_N0 As String) As String
- Dim element As Object
- With CreateObject("InternetExplorer.Application")
- .Navigate "http://bsr.twse.com.tw/bshtm/bsMenu.aspx"
- Do While .Busy Or .ReadyState <> 4
- DoEvents
- Loop
- .Document.getElementsByName("txtTASKNO")(0).Value = Sstock_N0
- .Document.getElementsByName("btnOK")(0).Click
- Do While .Busy Or .ReadyState <> 4
- DoEvents
- Loop
- 報表頁數 = .Document.getElementsByName("sp_ListCount")(0).innertext
- .Quit
- End With
- End Function
|
|
發表於 2013-9-28 16:40
| 