請問能否將2個VBA巨集合併成1個VBA巨集 - Excel程式區

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

8^# 跳轉到 »

發表於 2015-7-26 09:22 | 只看該作者

本帖最後由 no3-taco 於 2015-7-26 09:24 編輯

先加入程式碼裡面那兩行，修改完後跑一次
應該會出現兩次訊息框，記住數字然後改
E.all.Length >= IIf(i = 0, 431, 150) '第一次出現數字替換431 ,第二次出現數字替換150

無誤後,插入的那兩行就可以刪掉了
不曉得是不是ie版本不同的關係

'.Visible = True '先隱藏
Dim Atime: Atime = Timer '加入這裡######_1
Do
Do
Set E = .document.getElementsByTagName("TABLE")(21 + i)
'即時淨值第21個 "TABLE" ,'國內指數第22個 "TABLE"
Loop Until Not E Is Nothing
If Timer - Atime > 5 Then MsgBox E.all.Length: Exit Do '加入這裡######_2
Loop Until E.all.Length >= IIf(i = 0, 431, 150) '跑過一次後要修改的地方

複製代碼

TOP

lcctno

中學生 Rank: 2

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

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

7^#

發表於 2015-7-26 08:23 | 只看該作者

回復 6# GBKEE

1.應該不是下載或上傳速度的問題我是使用中華電信光世代上網的

2.應該是我過程敘述的不好我再敘述的清楚一點
當執行該巨集後 EXCELL檔內並未載入任何東西空白一片當下只發生自動開啟IE11 停在"5樓的圖1.會卡住" 當我關掉IE後就出現 "圖2.錯誤訊息" 圖3.是偵錯後的截圖

再次的感謝您的用心的幫助希望您看懂初學者的我在敘述什麼

TOP

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兔年全勤獎章

6^#

發表於 2015-7-26 07:28 | 只看該作者

本帖最後由 GBKEE 於 2015-7-26 07:32 編輯

回復 5# lcctno

IE 為何會中斷連繫? Ie8 很順暢的,ADSL 5M/384K
請告知網址是 i=0 即時淨值, i=1國內指數
如會中斷連繫這裡就會了

Do
Set E = .Document.getElementsByTagName("TABLE")(21 + i)
'即時淨值第21個 "TABLE" ,'國內指數第22個 "TABLE"
Loop Until Not E Is Nothing

複製代碼

修改試試

If i = 0 Then '國內指數:不需按下同意鍵
Do
Set E = .Document.getElementByid("Agree")
Loop Until Not E Is Nothing
E.Click
Do While .Busy Or .readyState <> 4: DoEvents: Loop
End If

複製代碼

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

TOP

lcctno

中學生 Rank: 2

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

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

5^#

發表於 2015-7-25 23:40 | 只看該作者

回復 4# GBKEE

感謝您的幫助但我費了些時間還是無法解決問題問題如下希望不是大問題再次的謝謝您的幫助

1.會卡住

2.錯誤訊息

3.偵錯

TOP

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兔年全勤獎章

4^#

發表於 2015-7-25 14:01 | 只看該作者

回復 3# lcctno
試試看

Option Explicit
Sub Ex()
Dim E As Object, Ar(), i As Integer
Ar = Array("http://www.yuantaetfs.com/#/RtNav/Index", "http://www.yuantaetfs.com/#/Home/Index")
'Ar = Array(網址:即時淨值,網址:國內指數) 網址置入陣列
ActiveSheet.UsedRange.Clear
For i = 0 To 1
With CreateObject("InternetExplorer.Application")
.Visible = True
.Navigate Ar(i)
Do While .Busy Or .readyState <> 4: DoEvents: Loop
If i = 0 Then '國內指數:不需按下同意鍵
Do
Set E = .Document.getElementByid("Agree")
Loop Until Not E Is Nothing
E.Click
End If
Do
Do
Set E = .Document.getElementsByTagName("TABLE")(21 + i)
'即時淨值第21個 "TABLE" ,'國內指數第22個 "TABLE"
Loop Until Not E Is Nothing
Loop Until E.all.Length >= IIf(i = 0, 431, 150) '
.Document.body.innerHTML = E.outerHTML
.ExecWB 17, 2 ' Select All
.ExecWB 12, 2 ' Copy selection
With ActiveSheet
.Range("A" & IIf(i = 0, 1, 27)).Select
.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
With .Range(IIf(i = 0, "D16:D17", "C27:C28")).Interior
.ColorIndex = 35
.Pattern = xlSolid
End With
End With
.Quit '關閉網頁
End With
Next
End Sub