[發問] 請教 如何在EXCELL取得該網站之&quot;即時估計淨值&quot;

帖子: 41
主題: 0
精華: 0
積分: 79
點名: 0
作業系統: win7
軟體版本: 2010
閱讀權限: 20
性別: 男
註冊時間: 2014-4-1
最後登錄: 2016-2-17

32^#

發表於 2015-7-24 14:10 | 只看該作者

回復 32# yan2463

這隻程式不適合定時執行，但還是貼上來給你參考!!

Option Explicit
Public doneT As Boolean
Sub Exnets123() '
Dim E As Object, tTime, tabtxt As String
With CreateObject("InternetExplorer.Application")
'.Visible = True 'False
.navigate "http://www.yuantaetfs.com/#/RtNav/Index"
Do While .Busy Or .readyState <> 4: DoEvents: Loop
Application.SendKeys "~", True '按下同意鍵
'.document.getElementsByTagName("button")(0).Click '按下同意鍵
tTime = Timer
Do
Set E = .document.getElementsByTagName("TABLE")(21) '改(22)也可，E.all.Length="數量要跟著改"
DoEvents
If Timer - tTime > 5 Then MsgBox "請修改 E.all.Length =" & E.all.Length: Exit Do '確定無誤後可關閉
Loop Until Not E Is Nothing And E.all.Length = 415 '數量可能會不太一樣
tabtxt = .document.getElementsByTagName("TABLE")(21).outerHTML
tabtxt = Replace(tabtxt, "0"">▲", "")
tabtxt = Replace(tabtxt, "▼", "")
tabtxt = Replace(tabtxt, "0"">▲", "")
tabtxt = Replace(tabtxt, "▼", "")
.document.body.innerHTML = tabtxt
.ExecWB 17, 2 ' Select All
.ExecWB 12, 2 ' Copy selection
With ActiveSheet ''修改你要貼上的工作表
.Cells.Clear
.[a1].Select
.PasteSpecial 'NoHTMLFormatting:=True '(取消註解，改成純文字貼上)
End With
'Selection.Columns.AutoFit
.Quit '關閉網頁
End With
If doneT = True Then
Application.OnTime Time + #12:00:10 AM#, "Exnets123" '間隔多少時間開啟
End If
End Sub
Sub 開關() '另設按鈕
doneT = IIf(doneT = True, False, True) '自行修改適合的方式
MsgBox IIf(doneT = True, "定時開啟", "定時關閉") '開啟再去執行Exnets123程式就能間隔執行，關閉就能取消間隔執行
End Sub

複製代碼

yan2463

帖子: 112
主題: 29
精華: 0
積分: 173
點名: 0
作業系統: win7
軟體版本: OFFICE 2013
閱讀權限: 20
性別: 男
註冊時間: 2013-8-29
最後登錄: 2022-10-17

2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章

31^#

發表於 2015-7-24 09:28 | 只看該作者

回復 30# yan2463

我有下載25樓的VBA,想以這個檔案延伸
1.因需要按鈕才會更新,想請問是否有每一分或十分鐘檔案可自行更新
2.如要用按鈕更新,如何才能在在A工作表更新鈕,在工作表B更新
3.對VBA真的不熟,所以不知這樣問是否OK

lcctno

帖子: 142
主題: 18
精華: 0
積分: 160
點名: 305
作業系統: win10 64位元
軟體版本: office2003
閱讀權限: 20
性別: 男
來自: 臺灣高雄市
註冊時間: 2015-7-18
最後登錄: 2024-11-15

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章

30^#

發表於 2015-7-23 20:59 | 只看該作者

回復 1# yan2463

yan2463 請問您的問題解決了嗎?
yan2463 說：
回復 lcctno 我的問題尚未解決

回復 yan2463
請看 26樓
http://forum.twbts.com/redirect. ... 5&fromuid=21526

yan2463

帖子: 112
主題: 29
精華: 0
積分: 173
點名: 0
作業系統: win7
軟體版本: OFFICE 2013
閱讀權限: 20
性別: 男
註冊時間: 2013-8-29
最後登錄: 2022-10-17

2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章

29^#

發表於 2015-7-23 10:06 | 只看該作者

[版主管理留言]

GBKEE(2015/7/23 10:23): 請po上程式碼

回復 25# no3-taco

請問如果想每1分鐘,或每十分鐘自動更新一次,該如何改

帖子: 41
主題: 0
精華: 0
積分: 79
點名: 0
作業系統: win7
軟體版本: 2010
閱讀權限: 20
性別: 男
註冊時間: 2014-4-1
最後登錄: 2016-2-17

28^#

發表於 2015-7-19 20:22 | 只看該作者

回復 28# GBKEE

之前有一篇帖子也是卡在這裡，今天終於看到更好的解決辦法了。:lol

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

27^#

發表於 2015-7-19 20:13 | 只看該作者

回復 27# no3-taco

Application.Wait Now + #12:00:02 AM# '經常沒抓到改2秒

網頁頻寬下載速度跟不上程式執行的速度所致
可修改如下

'Application.Wait Now + #12:00:01 AM#
Do
Set E = .Document.getElementsByTagName("TABLE")(21)
Loop Until Not E Is Nothing And E.ALL.Length = 431
.Document.body.innerHTML = E.outerHTML

複製代碼

如圖示程式會停在中斷點

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

帖子: 41
主題: 0
精華: 0
積分: 79
點名: 0
作業系統: win7
軟體版本: 2010
閱讀權限: 20
性別: 男
註冊時間: 2014-4-1
最後登錄: 2016-2-17

26^#

發表於 2015-7-19 19:34 | 只看該作者

回復 26# lcctno

.Visible = True 改成下面
.Visible = False '可以隱藏ie

如果偶爾抓不到，多按幾下，或者把時間增加到兩秒
Application.Wait Now + #12:00:02 AM# '經常沒抓到改2秒

lcctno

帖子: 142
主題: 18
精華: 0
積分: 160
點名: 305
作業系統: win10 64位元
軟體版本: office2003
閱讀權限: 20
性別: 男
來自: 臺灣高雄市
註冊時間: 2015-7-18
最後登錄: 2024-11-15

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章

25^#

發表於 2015-7-19 19:12 | 只看該作者

回復 25# no3-taco

哇真的成功了非常非常的感謝您的努力(幫助) 我得好好研究您提供的內容了

可用之測試檔

即時估計淨值.zip (9.49 KB)

帖子: 41
主題: 0
精華: 0
積分: 79
點名: 0
作業系統: win7
軟體版本: 2010
閱讀權限: 20
性別: 男
註冊時間: 2014-4-1
最後登錄: 2016-2-17

24^#

發表於 2015-7-19 17:50 | 只看該作者

我不太會用回復，再試看看

Option Explicit
Sub Ex()
Dim E As Object, myItems As Object, myitem
With CreateObject("InternetExplorer.Application")
.Visible = True
.Navigate "http://www.yuantaetfs.com/#/RtNav/Index"
Do While .Busy Or .readyState <> 4: DoEvents: Loop
'Application.Wait Now + #12:00:01 AM# '有錯在開啟
Set myItems = .Document.getElementsByTagName("button")
For Each myitem In myItems
If myitem.Name = "Agree" Then
myitem.Click '按下送出查詢按鈕
End If
Next
Application.Wait Now + #12:00:01 AM#
Set E = .Document.getElementsByTagName("TABLE")(21)
.Document.body.innerHTML = E.outerHTML
.ExecWB 17, 2 ' Select All
.ExecWB 12, 2 ' Copy selection
With ActiveSheet
.Cells.Clear
.[A1].Select
.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
End With
.Quit '關閉網頁
End With
End Sub

複製代碼