返回列表 上一主題 發帖

[發問] 請高手指導修正"即時估計淨值"

[發問] 請高手指導修正"即時估計淨值"

本帖最後由 lcctno 於 2016-3-15 09:17 編輯

這是元大寶來ETF淨值的網址
http://www.yuantaetfs.com/#/RtNav/Index

如圖 這是元大寶來網路看到的ETF淨值
~元大寶來ETF淨值網站.jpg
2016-3-15 09:06


這圖是本來今天之前的即時淨值圖
~本來.jpg
2016-3-15 09:08


這圖是我目前無法使用的即時淨值圖
~目前.jpg
2016-3-15 09:08


我嘗試了很久 無法弄好VBA 麻煩高手幫我解決問題 謝謝
附件:即時淨值.zip
~即時淨值.zip (11.64 KB)

本帖最後由 lcctno 於 2016-3-15 09:38 編輯

這是即時淨值VBA 剛剛漏了寫 麻煩高手幫我修正成可正常使用的EXCELL表格

Sub 即時淨值()

Dim E As Object, myItems As Object, myitem
    With CreateObject("InternetExplorer.Application")
        .Visible = True
        .Navigate "http://www.yuantaetfs.com/#/RtNav/Index"
        
        Application.Wait Now + #12:00:03 AM#   '有錯在開啟

        Set myItems = .Document.getElementsByTagName("button")
        For Each myitem In myItems
        
        'Application.Wait Now + #12:00:00 AM#   '有錯在開啟
        
            If myitem.Name = "Agree" Then
            
                myitem.Click    '按下送出查詢按鈕

            End If
        Next

        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

TOP

您試試看
  1. Sub 即時淨值()
  2. Application.ScreenUpdating = False
  3. Cells.Delete
  4. Dim E As Object, myItems As Object, myitem
  5.     With CreateObject("InternetExplorer.Application")
  6.         .Visible = True
  7.         .Navigate "http://www.yuantaetfs.com/#/RtNav/Index"
  8.         
  9.         Application.Wait Now + #12:00:03 AM#   '有錯在開啟

  10.         Set myItems = .Document.getElementsByTagName("button")
  11.         For Each myitem In myItems
  12.         
  13.         'Application.Wait Now + #12:00:00 AM#   '有錯在開啟
  14.         
  15.             If myitem.Name = "Agree" Then
  16.             
  17.                 myitem.Click    '按下送出查詢按鈕

  18.             End If
  19.         Next

  20.         Set E = .Document.getElementsByTagName("TABLE")(22)
  21.          .Document.body.innerHTML = E.outerHTML
  22.         .ExecWB 17, 2       '  Select All
  23.         .ExecWB 12, 2       '  Copy selection
  24.         With ActiveSheet
  25.             '.Cells.Clear
  26.             .[A1].Select
  27.             .PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
  28.         End With
  29.         .Quit        '關閉網頁
  30.     End With
  31.    
  32.     x = Cells(Rows.Count, 1).End(xlUp).Row

  33.   For A = x To 6 Step -1
  34.     If Cells(A, 3) = "" Then
  35.         Rows(A).Delete
  36.     End If
  37.   Next
  38.   
  39.   Application.ScreenUpdating = True
  40. End Sub
複製代碼
回復 2# lcctno

TOP

回復 3# joey0415
感謝您的幫忙
但會缺台灣50 如圖
~缺台灣50.jpg
2016-3-15 12:29

TOP

回復 4# lcctno

小修改一下,應該可以
  1. Sub 即時淨值()
  2. Application.ScreenUpdating = False
  3. Cells.Delete
  4. Dim E As Object, myItems As Object, myitem
  5.     With CreateObject("InternetExplorer.Application")
  6.         .Visible = True
  7.         .Navigate "http://www.yuantaetfs.com/#/RtNav/Index"
  8.         
  9.         Application.Wait Now + #12:00:03 AM#   '有錯在開啟

  10.         Set myItems = .Document.getElementsByTagName("button")
  11.         For Each myitem In myItems
  12.         
  13.         'Application.Wait Now + #12:00:00 AM#   '有錯在開啟
  14.         
  15.             If myitem.Name = "Agree" Then
  16.             
  17.                 myitem.Click    '按下送出查詢按鈕

  18.             End If
  19.         Next

  20.         Set E = .Document.getElementsByTagName("TABLE")(21)
  21.          .Document.body.innerHTML = E.outerHTML
  22.         .ExecWB 17, 2       '  Select All
  23.         .ExecWB 12, 2       '  Copy selection
  24.         With ActiveSheet
  25.             '.Cells.Clear
  26.             .[A1].Select
  27.             .PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
  28.         End With
  29.         .Quit        '關閉網頁
  30.     End With
  31.     x = Cells(Rows.Count, 2).End(xlUp).Row

  32.   For A = x To 6 Step -1
  33.     If Cells(A, 4) = "" Then
  34.         Rows(A).Delete
  35.     End If
  36.   Next
  37.   Columns(1).Delete
  38.   Application.ScreenUpdating = True
  39. End Sub
複製代碼

TOP

回復 5# joey0415
目前還是缺台灣50 我今日上傳的語法 就會缺台灣50 但之前的有台灣50
您請看圖最上方 有短少的台灣50資料


~缺台灣50-2.jpg
2016-3-15 13:26

TOP

回復 6# lcctno
你再試試
  1. Sub 即時淨值()
  2. Application.ScreenUpdating = False
  3. Cells.Delete
  4. Dim E As Object, myItems As Object, myitem
  5.     With CreateObject("InternetExplorer.Application")
  6.         .Visible = True
  7.         .Navigate "http://www.yuantaetfs.com/#/RtNav/Index"
  8.         
  9.         Application.Wait Now + #12:00:03 AM#   '有錯在開啟

  10.         Set myItems = .Document.getElementsByTagName("button")
  11.         For Each myitem In myItems
  12.         
  13.         'Application.Wait Now + #12:00:00 AM#   '有錯在開啟
  14.         
  15.             If myitem.Name = "Agree" Then
  16.                 myitem.Click    '按下送出查詢按鈕
  17.             End If
  18.         Next
  19.             Set r = .Document.All.tags("table")(22).Rows
  20.             n = Cells(Rows.Count, 1).End(xlUp).Row
  21.             For i = 2 To r.Length - 1
  22.                 For j = 0 To r(i).Cells.Length - 2
  23.                     Cells(i + n + 1 - 3, j + 1) = r(i).Cells(j).innerText
  24.                 Next j
  25.             Next
  26.             
  27.         x = Cells(Rows.Count, 1).End(xlUp).Row
  28.             For A = x To 1 Step -1
  29.               If Cells(A, 3) = "" Then
  30.                   Rows(A).Delete
  31.               End If
  32.             Next
  33.         .Quit
  34.         End With
  35.   
  36.   Application.ScreenUpdating = True
  37. End Sub
複製代碼

TOP

本帖最後由 lcctno 於 2016-3-15 21:30 編輯

回復 7# joey0415
回復: 高手 正常了
可以分享您的解決方法嗎?
為何我貼的語法 台灣50會不正常 無法全部顯視(只能顯視部分的資訊)
您可不可以幫我上傳的部分您修改的地方 說明一下 是否能將"資料時間"能顯示出來
謝謝您的辛苦了

TOP

本帖最後由 lcctno 於 2016-3-16 09:23 編輯

回復 7# joey0415
現在有個比較大的問題是
只要一更新淨值 其他使用該資訊的連結就會發生問題 (請看更新後)
您可不可以將VBA改為我最原始的樣子
但要有0050的全部資訊
不用需要完美的再排序 謝謝您了

若不缺0050 這是我可以用的即時淨值圖
1603150908e96b0d634d8d921c.jpg.thumb.jpg
2016-3-16 09:20


更新前
~更新前.jpg
2016-3-16 09:09


更新後
~更新後.jpg
2016-3-16 09:09


附件
~即時淨值.zip (16.05 KB)

TOP

        靜思自在 : 真正的愛心,是照顧好自己的這顆心。
返回列表 上一主題