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

|
7#
發表於 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
大大請問這該怎麼改當天的
感覺我的跑很慢
請幫我忙一下謝謝 |
|