- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
本帖最後由 GBKEE 於 2013-3-30 16:06 編輯
回復 3# spermbank - 這網頁有修改控制項,2# 這些程式碼不適用, 4#的程式碼已修改為正確
- Ie.Document.ALL(632).Value = "sii" '上市 = sii,上櫃 = otc,興櫃 = rotc,公開發行 = pub
- Ie.Document.ALL(643).Value = "101" '年度
- Ie.Document.ALL(650).Value = "04" '第一季 = 01,第二季 = 02,第三季 = 03,第四季 = 04
- Ie.Document.ALL(667).Click
- Option Explicit
- Sub 公開資訊觀測站()
- Dim ie As Object, xx, k, j, i, AA As Variant
- Dim T As Date, 資訊 As String
- Do
- 資訊 = InputBox("1: 損益表" & vbLf & "2: 合併損益表") '選擇公開資訊觀測站的表格
- '資訊 = InputBox("1: 損益表" & vbLf & "2: 合併損益表"& vbLf & "3: ???表"...............)
- If 資訊 = "" Then Exit Sub '不選擇結束程式
- Loop Until Val(資訊) > 0 And Val(資訊) <= 2 ' Val(資訊)<=??? 結束選擇表單
- ActiveSheet.Cells.Clear
- Application.DisplayStatusBar = True
- Application.StatusBar = "....... 網頁開啟中.......... "
-
- ' On Error GoTo ie_err
- Set ie = CreateObject("InternetExplorer.Application")
- ie.Navigate 下載網址(資訊)
- Do While ie.Busy Or ie.ReadyState <> 4
- DoEvents
- Loop
- With ie.Document
- T = Time
- Do While ie.Busy Or ie.ReadyState <> 4
- If Time = T + #12:01:00 AM# Then GoTo ie_err '等候網頁異常:結束程式
- DoEvents
- Loop
- '********** 修改這裡 的選項
- .getelementbyID("TYPEK").Value = "sii" '上市 = sii,上櫃 = otc,興櫃 = rotc,公開發行 = pub
- .getelementbyID("year").Value = "101" '年度
- .getelementbyID("season").Value = "02" '第一季 = 01,第二季 = 02,第三季 = 03,第四季 = 04
- For i = 0 To .getelementsbytagname("input").Length - 1
- If .getelementsbytagname("input")(i).Type = "button" And .getelementsbytagname("input")(i).Value = " 搜尋 " Then
- .getelementsbytagname("input")(i).Click
- End If
- Next
- 等待網頁
- Set AA = .getelementsbytagname("table") '資料區
- End With
- T = Time
- With ActiveSheet
- .Cells(1, "A") = IIf(資訊 = 1, "損益表", "合併損益表")
- .Cells(1, "B") = 市場別(ie.Document.getelementbyID("TYPEK").Value)
- .Cells(1, "C") = ie.Document.getelementbyID("year").Value & "年度"
- .Cells(1, "D") = ie.Document.getelementbyID("season").Value & "季"
- .Cells(1).Select
- Application.ScreenUpdating = False
- k = 1
- On Error Resume Next
- For xx = 網頁表格(資訊) To AA.Length - 1
- For i = 0 To AA(xx).Rows.Length - 1 '寫入資料
- k = k + 1
- For j = 0 To 19
- Application.StatusBar = "下載資料中 ..." & k - 1
- .Cells(k, j + 1) = AA(xx).Rows(i).Cells(j).innertext
- Next
- Next
- Next
- Set AA = .Range("S3:S" & .[S3].End(xlDown).Row)
- AA.Replace "基本每股盈餘", "", xlWhole
- AA.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
- .Cells(.Rows.Count, 1).End(xlUp).EntireRow.Delete
- .Cells.EntireColumn.AutoFit
- .[A1].Select
- End With
- Application.ScreenUpdating = True
- ie.Quit
- Application.StatusBar = "下載資料時間 : " & Format(Time - T, ["S秒"])
- End
- ie_err:
- ie.Quit
- MsgBox "網頁有問題,請重新執行..."
- End
- 資訊_Err:
- End Sub
- Private Sub 等待網頁() '等待網頁下載資料完畢的時間
- Dim Tt(1 To 3) As Date
- Tt(1) = Time
- Tt(2) = Time
- Tt(3) = #12:00:10 AM# '10秒 調整這裡
- Do
- If Time > Tt(2) Then
- Application.StatusBar = "網頁下載中 剩餘秒數.. " & Second(Tt(1) + Tt(3) - Time)
- Tt(2) = Time
- End If
- DoEvents
- Loop Until Time > Tt(1) + Tt(3)
- Application.StatusBar = "資料下載中...."
- End Sub
- Private Function 下載網址(xWord As String) As String '傳回選擇的網址
- Select Case xWord
- Case "1"
- 下載網址 = "http://mops.twse.com.tw/mops/web/t51sb08" '損益表
- Case "2"
- 下載網址 = "http://mops.twse.com.tw/mops/web/t51sb13" '合併損益表
- ''Case "3" 新網頁的網址
- ''
- ''
- End Select
- End Function
- Private Function 市場別(xWord As String) As String
- '上市 = sii,上櫃 = otc,興櫃 = rotc,公開發行 = pub
- Select Case xWord
- Case "sii"
- 市場別 = "上市"
- Case "otc"
- 市場別 = "上櫃"
- Case "rotc"
- 市場別 = "興櫃"
- Case "pub"
- 市場別 = "公開發行"
- End Select
- End Function
- Private Function 網頁表格(xWord As String) As Integer
- Select Case xWord
- Case "1"
- 網頁表格 = 13 '損益表
- Case "2"
- 網頁表格 = 12 '合併損益表
-
- ''每一網頁的表單建置不一樣,需一一去尋找
- '' 自行查看新增 Case "3"......
- ''
- End Select
- End Function
|
|
發表於 2013-3-29 20:14
| 