- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
本帖最後由 GBKEE 於 2013-5-19 15:36 編輯
回復 1# randomwalk
這網頁: 無論是[最新資料] 或 [歷史資料] 的資料都一樣???- Sub Ex()
- Dim i As Integer, s As Integer, k As Integer, A, ii, j
- Dim co_id As String, isnew As String, season As String
- co_id = InputBox("請輸入 公司代號")
- If Not IsNumeric(Val(co_id)) Or Len(co_id) <> 4 Then Exit Sub '不是四位數的數字
- isnew = InputBox("1:最新資料，２:歷史資料" & vbLf & "請選 1 , 2")
- If isnew <> "1" And isnew <> "2" Then Exit Sub '沒選1 或 2
- If isnew = "2" Then season = InputBox("輸入年度 , 季別" & vbLf & "例 101,01")
- '第一季 01,第二季 02第三季 03,第四季 04.
- With CreateObject("InternetExplorer.Application")
- .Visible = True
- .Navigate "http://mops.twse.com.tw/mops/web/t164sb04"
- Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
- With .document
- For Each A In .getelementsbytagname("INPUT")
- If A.Name = "co_id" Then A.Value = co_id
- Next
- For Each A In .getelementsbytagname("SELECT")
- If A.Name = "isnew" Then
- A.Value = True
- If isnew = "2" Then
- A.Focus
- Application.Wait Now + #12:00:02 AM#
- Application.SendKeys "{DOWN}"
- Application.Wait Now + #12:00:02 AM#
- Application.SendKeys "{ENTER}"
- End If
- End If
- If A.Name = "year" And isnew = "2" Then A.Value = Split(season, ",")(0)
- If A.Name = "season" And isnew = "2" Then A.Value = Split(season, ",")(1)
- Next
- For Each A In .getelementsbytagname("INPUT")
- If Trim(A.Value) = "搜尋" And A.Name <> "rulesubmit" Then A.Click '按下[搜索]鍵
- Next
- End With
- Application.Wait Now + #12:00:10 AM# '等待網頁下載資料
- Set A = .document.getelementsbytagname("table")
- On Error Resume Next '***有些table沒Rows資料會產生錯誤 不理會它,程式繼續走
- With ActiveSheet
- .Cells.Clear
- '************************
- ' For ii = 0 To A.Length - 1 '不知道table範圍在何處: 從0開始
- '******************************
- For ii = 11 To A.Length - 1 ''從11開始 用 Debug.Print ii 找出所要資料的table範圍
- For i = 0 To A(ii).Rows.Length - 1 '寫入資料
- 'Debug.Print ii 可找出所要資料的 table 範圍
- k = k + 1
- For j = 0 To 5
- Cells(k, j + 1) = A(ii).Rows(i).Cells(j).innerText
- Next
- Next
- Next
- .Range("C5").Cut Range("D5")
- With .Range("B5:C5,D5:E5")
- .HorizontalAlignment = xlCenter
- .VerticalAlignment = xlCenter
- .Merge
- End With
- End With
- .Quit '關閉網頁
- End With
- End Sub
- Option Explicit
- Dim 網頁 As Object
- Sub Ex簡易手動()
- '程式第一次執行: 打開網頁,在網頁中手動,選擇資料後 , 按[搜尋]鍵!!
- '程式第二次執行: 讀取網頁資料到 Excel中.
- '往後在網頁資料有修改,只需執行一次即可讀取網頁資料到 Excel中.
- Dim i As Integer, ii As Integer, k As Integer, j As Integer, A As Object
- On Error GoTo RE網頁
- 1:
- If 網頁 Is Nothing Then
- Set 網頁 = CreateObject("InternetExplorer.Application")
- With 網頁
- .Visible = True
- .Navigate "http://mops.twse.com.tw/mops/web/t164sb04"
- .Height = 500
- .Width = 1300
- End With
- Application.WindowState = xlMinimized 'Excel 最小化
- Exit Sub
- End If
- If 網頁.Visible = False Then
- 網頁.Value = True
- Application.WindowState = xlMinimized
- Exit Sub
- End If
- '**********讀取網頁 資料 *******************
- Set A = 網頁.document.getelementsbytagname("table")
- With ActiveSheet '作用中的工作表
- .Cells.Clear
- On Error Resume Next
- For ii = 11 To A.Length - 1
- For i = 0 To A(ii).Rows.Length - 1 '寫入資料
- k = k + 1
- For j = 0 To 5
- Cells(k, j + 1) = A(ii).Rows(i).Cells(j).innerText
- Next
- Next
- Next
- .Range("C5").Cut .Range("D5")
- With .Range("B5:C5,D5:E5")
- .HorizontalAlignment = xlCenter
- .VerticalAlignment = xlCenter
- .Merge
- End With
- End With
- Exit Sub
- RE網頁: '
- Set 網頁 = Nothing
- Resume 1
- End Sub
|
|
發表於 2013-5-19 15:17
| 
