返回列表 上一主題 發帖

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

lcctno

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

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2016-3-15 09:15 | 只看該作者

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

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

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

如圖 這是元大寶來網路看到的ETF淨值


這圖是本來今天之前的即時淨值圖


這圖是我目前無法使用的即時淨值圖


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

lcctno

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

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章
2#
發表於 2016-3-15 09:35 | 只看該作者
本帖最後由 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

joey0415
　暱稱: joey0415

中學生Rank: 2

帖子
361 
主題
57 
精華
0 
積分
426 
點名
0  
作業系統
win7 
軟體版本
2003,2010 
閱讀權限
20 
性別
男 
註冊時間
2010-5-13 
最後登錄
2022-12-8 
3#
發表於 2016-3-15 12:01 | 只看該作者
您試試看
  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#   '有錯在開啟

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

  20.             End If
  21.         Next

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

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

TOP

lcctno

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

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章
4#
發表於 2016-3-15 12:30 | 只看該作者
回復 3# joey0415
感謝您的幫忙
但會缺台灣50 如圖

TOP

joey0415
　暱稱: joey0415

中學生Rank: 2

帖子
361 
主題
57 
精華
0 
積分
426 
點名
0  
作業系統
win7 
軟體版本
2003,2010 
閱讀權限
20 
性別
男 
註冊時間
2010-5-13 
最後登錄
2022-12-8 
5#
發表於 2016-3-15 13:20 | 只看該作者
回復 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#   '有錯在開啟

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

  20.             End If
  21.         Next

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

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

TOP

lcctno

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

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章
6#
發表於 2016-3-15 13:29 | 只看該作者
回復 5# joey0415
目前還是缺台灣50 我今日上傳的語法 就會缺台灣50 但之前的有台灣50
您請看圖最上方 有短少的台灣50資料

TOP

joey0415
　暱稱: joey0415

中學生Rank: 2

帖子
361 
主題
57 
精華
0 
積分
426 
點名
0  
作業系統
win7 
軟體版本
2003,2010 
閱讀權限
20 
性別
男 
註冊時間
2010-5-13 
最後登錄
2022-12-8 
7#
發表於 2016-3-15 20:38 | 只看該作者
回復 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#   '有錯在開啟

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

TOP

lcctno

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

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章
8#
發表於 2016-3-15 21:18 | 只看該作者
本帖最後由 lcctno 於 2016-3-15 21:30 編輯

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

TOP

lcctno

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

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章
9#
發表於 2016-3-16 09:18 | 只看該作者
本帖最後由 lcctno 於 2016-3-16 09:23 編輯

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

若不缺0050 這是我可以用的即時淨值圖


更新前


更新後


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

TOP

        靜思自在 : 發脾氣是短暫的發瘋。
返回列表 上一主題