返回列表 上一主題 發帖

[發問] 有關交易所融資券餘額資料查詢網頁

vavashop

帖子
78 
主題
30 
精華
0 
積分
109 
點名
0  
作業系統
XP 
軟體版本
XP 
閱讀權限
20 
註冊時間
2014-5-15 
最後登錄
2018-9-16 

論壇贊助勳章
1# 跳轉到 »
發表於 2015-8-20 15:53 | 顯示全部帖子
Sub AAA()

Sheets("上市").Select
    Range("B1").Select
    Sheets("上市融資餘額").Select
    Cells.Select
    Selection.ClearContents
    Sheets("上市").Select
    Selection.Copy
    Sheets("上市融資餘額").Select
    Range("A1").Select
    ActiveSheet.Paste
   
   
   

  
   Dim y, m, d, param As String ' 宣告 y, m, d, param 為字串變數
    y = Sheets("上市融資餘額").Range("B2") ' 西元年
    m = Format(Sheets("上市融資餘額").Range("B3"), "00") ' 月，使用Format函數強制十位數補0
    d = Format(Sheets("上市融資餘額").Range("B4"), "00") ' 日，使用Format函數強制十位數補0
    param = (y - 1911) & "/" & m & " ' 民國年/月/日"



    Application.ScreenUpdating = False  '停止 更新Sheet時 畫面，加速運算
    Application.DisplayAlerts = False  '停止 刪除Sheet時 預設的警告
    Cells.Clear
    With CreateObject("internetexplorer.application")
        .Visible = True
        .Navigate "http://www.twse.com.tw/ch/trading/exchange/MI_MARGN/MI_MARGN.php"
        Do Until .ReadyState = 4
            DoEvents
        Loop
        
        .Document.getElementById("date-field").Value = param '填入
         
        '---------，內建的fireevent 的onchange失效，改用調用js的方法--------
        Set evt = .Document.createEvent("HTMLEvents")
        evt.initEvent "change", True, False
        Set lst = .Document.all("selectType") 'option的name是selectType，但getElementsByName無法處理，要all才行
        lst.selectedIndex = 1
        lst.dispatchEvent evt
   
        .Document.all("query-button").Click


         Do While .ReadyState <> 4 Or .Busy: DoEvents: Loop

        Application.Wait Now + TimeValue("00:00:5")
'        Stop
        
        'For Z = 0 To 10
        'MsgBox .Document.getElementsByTagName("table")(Z).innerText
        'Next
        Set hTable = .Document.getElementsByTagName("table")(4) '第4個table


                For i = 0 To hTable.Rows.Length - 1 '前3個是標題與空白跳過
                    For J = 0 To hTable.Rows(i).Cells.Length - 1
                        If J = 0 And i > 2 Then

                                Cells(i + 1, J + 1) = "'" & hTable.Rows(i).Cells(J).innerText

                            Else
                                Cells(i + 1, J + 1) = hTable.Rows(i).Cells(J).innerText
                        End If
                    Next
                Next


        .Quit
    End With
   
    Range("A3:B3").Insert Shift:=xlToRight
    Range("A2:B2").Select
    Selection.Cut
    Range("A3").Select
    ActiveSheet.Paste
    Range("E2:F2").Select
    Selection.Cut
    Range("O3").Select
    ActiveSheet.Paste
    Range("A1").Select
    Range("D2:h2").Insert Shift:=xlToRigh
   
        Application.ScreenUpdating = True  '停止 更新Sheet時 畫面，加速運算
        Application.DisplayAlerts = True '停止 刪除Sheet時 預設的警告
   
End Sub


大大請問這該怎麼改當天的
感覺我的跑很慢
請幫我忙一下謝謝

TOP

        靜思自在 : 能幹不幹，不如苦幹實幹。
返回列表 上一主題