- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
16#
發表於 2013-9-4 16:55
| 只看該作者
回復 15# t8899
是這樣嗎?- Option Explicit
- Sub Ex()
- Dim xlVbTable As Object, Ar, R As Integer, C As Integer, i As Variant, Y As Integer
- Dim t As Date, Msg As Boolean
- t = Time
- With CreateObject("InternetExplorer.Application")
- ' .Visible = True
- .Navigate "http://udn.megatime.com.tw/asp/hot/ShortOperate.asp?lcount=20&m=puplim&align=v"
- Do While (.Busy Or .ReadyState <> 4) And Msg = False
- DoEvents
- If Time > t + #12:00:05 AM# Then Msg = True
- Loop
- On Error Resume Next
- If Msg = True Then
- .Quit
- MsgBox "連線的時間超過5秒"
- Else
- Set xlVbTable = .document.getelementsbytagname("table")
- With Sheets("Sheet5")
- .Cells = ""
- .Cells(1, 1) = "漲停鎖死股"
- For Each i In Array(20, 24)
- If i = 24 Then .Cells(1, "J") = "跌停鎖死股"
- Y = 2
- For R = 0 To xlVbTable(i).Rows.Length - 1
- For C = 0 To xlVbTable(i).Rows(1).ALL.Length - 1
- .Cells(Y, C + IIf(i = 20, 1, 10)) = xlVbTable(i).Rows(R).Cells(C).innerText
- 'IIf(i = 20, 1, 10) -> 1:="A", 10:="J"
- Next
- Y = Y + 1
- Next
- If i = 20 Then .Rows(13).Delete '貼上連結的儲存格仍然是#REF!->儲存格被刪除掉
- Next
- End With
- .Quit
- Sheets("Sheet3").[I4:I22] = "=SHEET5!RC[-6]" '貼上連結的儲存格仍
- MsgBox Application.Text(Time - t, "費時 [ss] 秒")
- End If
- End With
- End Sub
|
|
發表於 2013-9-4 09:46
| 
