- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
2#
發表於 2016-4-18 10:49
| 只看該作者
本帖最後由 GBKEE 於 2016-4-18 10:50 編輯
回復 1# laieven
試試看- Option Explicit
- Sub Ex_營益分析查詢彙總表() '公開資訊觀測站
- Dim i As Variant, E As Object, Op As String, Sh As Worksheet, R As Integer, C As Integer
- Application.StatusBar = "'** 等候網頁 ....**"
- With CreateObject("InternetExplorer.Application")
- ' .Visible = True
- .Navigate "http://mops.twse.com.tw/mops/web/t163sb06"
- Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
- '[上市別] *****
- With .document.ALL("TYPEK")(1)
- For i = 0 To .ALL.Length - 1
- Op = Op & vbLf & i + 1 & .ALL(i).INNERTEXT
- Next
- DoEvents ' ** 回到 Excel
- Do
- Application.ActiveWindow.Activate
- i = Application.InputBox(Op, "營益分析查詢彙總表 [上市別]", 1, Type:=1)
-
- If i = 0 Then GoTo Exit_Sub
- Loop Until i <= .ALL.Length And i >= 1
- .selectedindex = i - 1
- End With
- '[年度] *****
- Do
- i = Application.InputBox(Format(Date, "ee"), "營益分析查詢彙總表 [年度]", Format(Date, "ee") - 1, Type:=1)
- If i = 0 Then GoTo Exit_Sub
- Loop Until i <= Format(Date, "ee")
- .document.ALL("year").Value = i
- '[季別] *****
- Do
- i = Application.InputBox(1, "營益分析查詢彙總表 [季別]", DatePart("q", Date), Type:=1)
- If i = 0 Then GoTo Exit_Sub
- Loop Until i <= 4 And i >= 1
- .document.ALL("season").selectedindex = i
- '** 網頁 按下 [搜尋]
- For Each E In .document.ALL.tags("INPUT")
- If E.Value = " 搜尋 " Then
- E.Click
- Exit For
- End If
- Next
- '** 等候網頁 載入資料
- Application.StatusBar = "'** 等候網頁 載入資料**"
- Do
- Set E = .document.BODY.ALL.tags("table")(11).Rows
- If InStr(.document.BODY.INNERTEXT, "查詢無資料") Then
- MsgBox "查詢無資料"
- Application.StatusBar = "** 網頁 查詢無資料**"
- GoTo Exit_Sub:
- End If
- DoEvents:
- Loop Until E.Length > 11
- '** 下載 資料
- Set Sh = Sheets(2) '指定 工作表
- Application.ScreenUpdating = False
- Application.StatusBar = "'** 載入資料 中 **"
- Set E = .document.BODY.ALL.tags("table")(11).Rows
-
- Sh.UsedRange.Clear
- For R = 0 To E.Length - 1
- For C = 0 To E(R).Cells.Length - 1
- If R > 1 And E(R).Cells(0).INNERTEXT = "公司代號" Then Exit For
- Sh.Cells(R + 1, C + 1) = E(R).Cells(C).INNERTEXT
- Next
- Next
- Sh.UsedRange.SpecialCells(xlCellTypeBlanks).Delete
- Sh.Activate
- Sh.[A1].Select
- Application.ScreenUpdating = True
- Application.StatusBar = .document.BODY.ALL.tags("table")(12).INNERTEXT
- Exit_Sub:
- .Quit '關閉網頁
- End With
- End Sub
|
|
發表於 2016-4-17 03:13
| 
