返回列表 上一主題 發帖

[發問] 請問能否將2個VBA巨集合併成1個VBA巨集

[發問] 請問能否將2個VBA巨集合併成1個VBA巨集

本帖最後由 lcctno 於 2015-7-23 21:06 編輯

我是初學者 網路上找了數天 但一直找不到方法 請高手們拉我一把 謝謝

VBA巨集.1
Sub 即時淨值()
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
    Range("L1:Q19").Select
    Selection.ClearContents
        Range("D16:D17").Select
    With Selection.Interior
        .ColorIndex = 35
        .Pattern = xlSolid
    End With
End Sub


VBA巨集 2
Sub 國內指數()
Dim E As Object, myItems As Object, myitem
    With CreateObject("InternetExplorer.Application")
        .Visible = True
        .Navigate "http://www.yuantaetfs.com/#/Home/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")(22)
         .Document.body.innerHTML = E.outerHTML
        .ExecWB 17, 2       '  Select All
        .ExecWB 12, 2       '  Copy selection
        With ActiveSheet
            '.Cells.Clear
            .[A27].Select
            .PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
        End With
        .Quit        '關閉網頁
        End With
         Range("A39:E39").Select
    Selection.ClearContents
        Range("C27:C28").Select
    With Selection.Interior
        .ColorIndex = 35
        .Pattern = xlSolid
    End With
End Sub

這樣嗎? 呵呵呵~ 不是很懂您想要的...

sub run_all()
call 即時淨值()
call 國內指數()
end sub
若是我回答,使您滿意,請您讓我知道!                  
若是我的回覆,您仍有其他見解,也請您不嗇指教!

TOP

回復 2# Min

感謝您熱心的回覆 但您這樣豈不是又增加了1個句集 變成3個巨集了
我是希望能夠簡化成一個巨集就能包含那2個巨集的動做 且功能不變

TOP

回復 3# lcctno
試試看
  1. Option Explicit
  2. Sub Ex()
  3.     Dim E As Object, Ar(), i As Integer
  4.     Ar = Array("http://www.yuantaetfs.com/#/RtNav/Index", "http://www.yuantaetfs.com/#/Home/Index")
  5.     'Ar = Array(網址:即時淨值,網址:國內指數) 網址置入陣列
  6.     ActiveSheet.UsedRange.Clear
  7.     For i = 0 To 1
  8.         With CreateObject("InternetExplorer.Application")
  9.             .Visible = True
  10.             .Navigate Ar(i)
  11.             Do While .Busy Or .readyState <> 4: DoEvents: Loop
  12.             If i = 0 Then  '國內指數:不需按下同意鍵
  13.                 Do
  14.                     Set E = .Document.getElementByid("Agree")
  15.                 Loop Until Not E Is Nothing
  16.                 E.Click
  17.             End If
  18.             Do
  19.                 Do
  20.                     Set E = .Document.getElementsByTagName("TABLE")(21 + i)
  21.                     '即時淨值 第21個 "TABLE" ,'國內指數 第22個 "TABLE"
  22.                 Loop Until Not E Is Nothing
  23.             Loop Until E.all.Length >= IIf(i = 0, 431, 150) '
  24.             .Document.body.innerHTML = E.outerHTML
  25.             .ExecWB 17, 2       '  Select All
  26.             .ExecWB 12, 2       '  Copy selection
  27.             With ActiveSheet
  28.                 .Range("A" & IIf(i = 0, 1, 27)).Select
  29.                 .PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
  30.                 With .Range(IIf(i = 0, "D16:D17", "C27:C28")).Interior
  31.                     .ColorIndex = 35
  32.                     .Pattern = xlSolid
  33.                 End With
  34.             End With
  35.             .Quit        '關閉網頁
  36.         End With
  37.     Next
  38. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 4# GBKEE

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

1.會卡住
卡住.jpg
2015-7-25 23:37


2.錯誤訊息
錯誤訊息.jpg
2015-7-25 23:37


3.偵錯
偵錯.jpg
2015-7-25 23:37

TOP

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

回復 5# lcctno

IE 為何會中斷連繫? Ie8 很順暢的,ADSL 5M/384K
請告知網址是 i=0 即時淨值, i=1國內指數
如會中斷連繫這裡就會了
  1. Do
  2.                     Set E = .Document.getElementsByTagName("TABLE")(21 + i)
  3.                     '即時淨值 第21個 "TABLE" ,'國內指數 第22個 "TABLE"
  4.                 Loop Until Not E Is Nothing
複製代碼
修改試試
  1. If i = 0 Then  '國內指數:不需按下同意鍵
  2.                 Do
  3.                     Set E = .Document.getElementByid("Agree")
  4.                 Loop Until Not E Is Nothing
  5.                 E.Click
  6.                 Do While .Busy Or .readyState <> 4: DoEvents: Loop
  7.             End If
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 6# GBKEE

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

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

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

TOP

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

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

無誤後,插入的那兩行就可以刪掉了
不曉得是不是ie版本不同的關係
  1. '.Visible = True                     '先隱藏

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

TOP

回復  GBKEE

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

2.應該是我過程敘述的不 ...
lcctno 發表於 2015-7-26 08:23


試試看...
  1. Option Explicit
  2. Sub Ex()
  3.     Dim E As Object, Ar(), i As Integer
  4.     Ar = Array("http://www.yuantaetfs.com/#/RtNav/Index", "http://www.yuantaetfs.com/#/Home/Index")
  5.     'Ar = Array(網址:即時淨值,網址:國內指數) 網址置入陣列
  6.     ActiveSheet.UsedRange.Clear
  7.     For i = 0 To 1
  8.         With CreateObject("InternetExplorer.Application")
  9.             .Visible = True
  10.             .Navigate Ar(i)
  11.             Do While .Busy Or .readyState <> 4: DoEvents: Loop
  12.             If i = 0 Then  '國內指數:不需按下同意鍵
  13.                 Do
  14.                     Set E = .Document.getElementByid("Agree")
  15.                 Loop Until Not E Is Nothing
  16.                 E.Click
  17.             End If
  18.             Do
  19.                 Do
  20.                     Set E = .Document.getElementsByTagName("TABLE")(21 + i)
  21.                     '即時淨值 第21個 "TABLE" ,'國內指數 第22個 "TABLE"
  22.                 Loop Until Not E Is Nothing
  23.             'Loop Until E.all.Length >= IIf(i = 0, 431, 150) '
  24.             Loop Until 0 < InStr(1, E.outerHTML, IIf(i = 0, "基本資料", "台灣加權股價指數"))  '改用相關字串確認是否有資料
  25.             .Document.body.innerHTML = E.outerHTML
  26.             .ExecWB 17, 2       '  Select All
  27.             .ExecWB 12, 2       '  Copy selection
  28.             With ActiveSheet
  29.                 .Range("A" & IIf(i = 0, 1, 27)).Select
  30.                 .PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
  31.                 With .Range(IIf(i = 0, "D16:D17", "C27:C28")).Interior
  32.                     .ColorIndex = 35
  33.                     .Pattern = xlSolid
  34.                 End With
  35.             End With
  36.             .Quit        '關閉網頁
  37.         End With
  38.     Next
  39. End Sub
複製代碼

TOP

本帖最後由 GBKEE 於 2015-7-27 09:53 編輯

回復 7# lcctno

當下只發生自動開啟IE11 停在"5樓的圖1.
此程式執行後會回到VBA編輯視窗,並打開'即時運算"的視窗
請第一個STOP 之後按下F5
如停留在VBA編輯視窗,"即時運算"一直有字串出現,代表程式一直在等後IE的資料,是IE 的問題
**請耐心等候到下 一個 STOP 之後按下F5 **
  1. Option Explicit
  2. Sub Ex()
  3.     Dim E As Object, Ar(), i As Integer
  4.     Ar = Array("http://www.yuantaetfs.com/#/RtNav/Index", "http://www.yuantaetfs.com/#/Home/Index")
  5.     'Ar = Array(網址:即時淨值,網址:國內指數) 網址置入陣列
  6.     ActiveSheet.UsedRange.Clear
  7.     For i = 0 To 1
  8.         With CreateObject("InternetExplorer.Application")
  9.             .Visible = True
  10.             .Navigate Ar(i)
  11.             Do While .Busy Or .readyState <> 4: DoEvents: Loop
  12.             If i = 0 Then  '國內指數:不需按下同意鍵
  13.                 Do
  14.                     Set E = .Document.getElementByid("Agree")
  15.                 Loop Until Not E Is Nothing
  16.                 E.Click
  17.             End If
  18.             .Visible = False
  19.             Application.VBE.MainWindow.Visible = True
  20.             Application.VBE.Windows("即時運算").Visible = True
  21.             Stop  '之後按下F5
  22.             Do
  23.                 Do
  24.                     Set E = .Document.getElementsByTagName("TABLE")(21 + i)
  25.                     '即時淨值 第21個 "TABLE" ,'國內指數 第22個 "TABLE"
  26.                     Debug.Print i, "e Is Nothing ->", E Is Nothing
  27.                 Loop Until Not E Is Nothing
  28.                     Debug.Print i, "e Is Nothing ->", E Is Nothing, "e.all.Length", E.all.Length
  29.             Loop Until E.all.Length >= IIf(i = 0, 431, 150) '
  30.             Stop  '之後按下F5
  31.             
  32.             Application.VBE.Windows("即時運算").Visible = False
  33.             Application.VBE.MainWindow.Visible = False
  34.             .Document.body.innerHTML = E.outerHTML
  35.             .ExecWB 17, 2       '  Select All
  36.             .ExecWB 12, 2       '  Copy selection
  37.             With ActiveSheet
  38.                 .Range("A" & IIf(i = 0, 1, 27)).Select
  39.                 .PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
  40.                 With .Range(IIf(i = 0, "D16:D17", "C27:C28")).Interior
  41.                     .ColorIndex = 35
  42.                     .Pattern = xlSolid
  43.                 End With
  44.             End With
  45.             .Quit        '關閉網頁
  46.         End With
  47.     Next
  48. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 看別人不順眼,是自己修養不夠。
返回列表 上一主題