12
返回列表 上一主題 發帖

[發問] 網頁資料很長，如何有效率地知道已完整進來

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
7# 跳轉到 »
發表於 2017-11-19 10:53 | 只看該作者
回復 6# Scott090
不錯的這樣就可以得到完整資料.
程式執行時間大約需一分鐘,我整理一下在狀態列上加上資訊.
  1. Option Explicit
  2. Dim Sh As Worksheet
  3. Dim xTimer As Date
  4. 'Dim Timer As Date   'Timer 為vba的內建函數 ,變數名稱盡量不要相同
  5. Sub Ex_網頁底部()
  6.     Dim E As Object, Ie_Date As Date, i As Integer
  7.     Application.DisplayStatusBar = True
  8.     Application.StatusBar = False
  9.     Set Sh = ActiveSheet
  10.     Sh.Cells.Clear
  11.     On Error GoTo EE
  12.     With CreateObject("InternetExplorer.Application")
  13.         '.Visible = True
  14.         xTimer = Time
  15.         .Navigate "https://finance.yahoo.com/quote/AAPL/history?period1=915206400&period2=1505174400&interval=1d&filter=history&frequency=1d"
  16.         Do While .Busy Or .readyState <> 4: DoEvents: Application.StatusBar = "******  等 候 網 頁 下....★★★" & GetTime:  Loop
  17.         Ie_Date = Getdate(.document.ALL.TAGS("INPUT")(4).Value)
  18.         Set E = .document.ALL.TAGS("tr")
  19.        Do
  20.             Application.StatusBar = "★★★★★  資料 下載中..." & GetTime & String(Val(GetTime), "★")
  21.             .document.Parentwindow.scrollby 0, 37900
  22.            ' Do While .Busy Or .readyState <> 4: DoEvents:            Loop
  23.            If Getdate(E(E.Length - 2).Cells(0).innertext) - Ie_Date < 5 Then Exit Do
  24.             DoEvents
  25.         Loop
  26.         Set E = .document.ALL.TAGS("TABLE")(1)
  27.         
  28.         Ep .document.ALL.TAGS("TABLE")(1).outerHTML
  29.         Application.StatusBar = "** ★" & xTimer & " - " & Time & "★" & GetTime & " ,下載 共 " & E.Rows.Length - 2 & " 筆資料 完畢 !! **"
  30.         .Quit        '關閉網頁
  31.     End With
  32.     With Sh
  33.         For i = 2 To .Range("A1").End(xlDown).Row - 1
  34.             .Range("A" & i) = Getdate(.Range("A" & i))
  35.         Next
  36.         .Range("A:A").NumberFormatLocal = "yyyy/mm/dd"
  37.     End With
  38.    
  39. Exit Sub
  40. EE:  '程式運行速度大於ie時的措施
  41.     Application.StatusBar = "網頁錯誤等候中....★★★ " & GetTime
  42.     Application.Wait (Second(Now()) + 2)
  43.     Resume
  44. End Sub
  45. Private Sub Ep(S As String)
  46.     With CreateObject("InternetExplorer.Application")
  47.         .Navigate "about:Tabs"
  48.        ' .Visible = True
  49.         .document.body.innerHTML = S
  50.         .ExecWB 17, 2       '  Select All
  51.         .ExecWB 12, 2       '  Copy selection
  52.         With Sh
  53.             .Activate
  54.            ' .Cells.Clear
  55.             .Range("A1").Select
  56.             .PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
  57.             .Range("A1").Select
  58.         End With
  59.         .Quit
  60.     End With
  61. End Sub
  62. Private Function Getdate(sDate As String) As Date
  63.     Dim A As String, b As Integer
  64.     A = Split(sDate, "-")(0)
  65.     b = AscW(Mid(A, 1, 1))
  66.     A = Replace(A, ChrW(b), " ")
  67.     A = Replace(A, "?", "")
  68.     Getdate = CDate(A)
  69. End Function
  70. Private Function GetTime() As String
  71.     GetTime = Application.Text(Time - xTimer, "   [S]秒")
  72. End Function
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

Scott090

帖子
533 
主題
58 
精華
0 
積分
613 
點名
253  
作業系統
win 10 
軟體版本
[] 
閱讀權限
50 
性別
男 
註冊時間
2013-3-19 
最後登錄
2026-10-18 

2025年全勤獎章2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章論壇榮譽勳章論壇贊助勳章2015羊年全勤獎章熱烈參與勳章
6#
發表於 2017-11-16 18:13 | 只看該作者
回復 4# GBKEE

從參考的網址內的各個變數，  
scrollHeight,  scrolltop,  offsetheight, clientHeight, body.clientheight .....
沒找出確實的 滾動數字相互之間的穩定關係，造成 激發滾動迴圈的不穩定性 及 取得的資料不一定 是底部最後一筆；
而，欲取得的資料格式是可以既知，所以改用 "是否最後一筆資料" 來決定滾動迴圈

把程式碼修飾如下：
增加 日期 變數 Dim startDate as date,  A

startdate = #1999/1/2#

'跳出迴圈條件 If .scrolltop + .clientHeight = .scrollHeight Then exit do 改成
A = E(E.Length - 2).Cells(0).INNERTEXT
If CDate(Mid(A, 2, 3) & " " & Mid(A, 8, 2) & ", " & Right(A, 4)) - startDate < 5 Then Exit Do

測試結果是穩定的

TOP

Scott090

帖子
533 
主題
58 
精華
0 
積分
613 
點名
253  
作業系統
win 10 
軟體版本
[] 
閱讀權限
50 
性別
男 
註冊時間
2013-3-19 
最後登錄
2026-10-18 

2025年全勤獎章2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章論壇榮譽勳章論壇贊助勳章2015羊年全勤獎章熱烈參與勳章
5#
發表於 2017-11-14 21:41 | 只看該作者
回復 4# GBKEE


    GBKEE大：
謝謝進一步的解答與教導 及提供的參考的網址
將繼續地瞭解與研究

感恩

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
4#
發表於 2017-11-14 15:27 | 只看該作者
回復 3# Scott090

參考這裡  http://www.jb51.net/article/57614.htm
2# 的程式碼修改了為
  1. With .document.documentElement
  2.                 ' Debug.Print .scrollTop , .clientHeighT, .scrollHeight  '***計算出 37900為最大值
  3.                 If .scrollTop + .clientHeighT = .scrollHeight Then Exit Do
  4.             End With
複製代碼
但測試時,.偶爾還是不能完全下載,有待努力
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

Scott090

帖子
533 
主題
58 
精華
0 
積分
613 
點名
253  
作業系統
win 10 
軟體版本
[] 
閱讀權限
50 
性別
男 
註冊時間
2013-3-19 
最後登錄
2026-10-18 

2025年全勤獎章2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章論壇榮譽勳章論壇贊助勳章2015羊年全勤獎章熱烈參與勳章
3#
發表於 2017-11-13 15:57 | 只看該作者
本帖最後由 Scott090 於 2017-11-13 16:01 編輯

回復 2# GBKEE


  謝謝  GBKEE 大的指導
為觀察網頁行為特性將兩種方法做一比較，執行結果如下表：
設定欲取資料期間；開始 1999/1/2， 結束期間 2017/9/12       


其中方法二並未完整的取得資料；
方法一則視 scrollby 的參數而定，設小了取資料不完整，設大了資料可以完整取得但有空轉的時間
謝謝
  1. Sub Ex_網頁底部()
  2.     Dim E As Object, R As Long, C As Long, i%
  3.     Dim timer As Date
  4.     'period1 = 1483286400     '2017/1/2
  5.     'period1 = 1451664000    '2016/1/2
  6.     'period1 = 915206400      '1999/1/2
  7.     'period2 = 1505174400     '2017/9/12

  9.     With CreateObject("InternetExplorer.Application")
  10.         .Visible = True
  11.         .Navigate "https://finance.yahoo.com/quote/AAPL/history?period1=915206400&period2=1505174400&interval=1d&filter=history&frequency=1d"
  12.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  13.         Set E = .document.ALL.TAGS("TR")
  14.        i = 0
  15.        timer = Time
  16.         Do
  17.             i = i + 1
  18.            With .document
  19. '方法一：
  20. '                .Parentwindow.scrollBy 0, 500  '改變 y 點數做試驗
  21. '                With .DocumentElement
  22. '                    R = R + .clientheight
  23. '                    Debug.Print "捲動次數：" & i, "R:" & R, "SH: " & .scrollHeight ', "CH: " & .clientheight
  24. '                    If R - .clientheight > .scrollHeight Then Exit Do
  25. '                End With
  26. '==============================================================
  27. '方法二：
  28.                   .Parentwindow.scrollBy 0, .DocumentElement.scrollHeight
  29.                   R = R + .DocumentElement.scrollHeight
  30.                   Debug.Print "捲動次數：" & i, "R:" & R, "SH: " & .DocumentElement.scrollHeight
  31.                   If R - .DocumentElement.scrollHeight > .DocumentElement.scrollHeight Then Exit Do
  32. ''''==============================================================
  33.                   
  34.             End With
  35.             DoEvents
  36.         Loop
  37.         
  38.         Debug.Print "時程： " & (Time - timer) * 86400
  39.         
  40.         ActiveSheet.Cells.Clear
  41.         For R = 1 To E.Length - 1
  42.             For C = 0 To E(R).Cells.Length - 1
  43.                 Cells(R, C + 1) = E(R).Cells(C).INNERTEXT
  44.             Next
  45.         Next
  46.         .Quit        '關閉網頁
  47.     End With
  48.     MsgBox "Ok"
  49. End Sub
複製代碼

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2017-11-13 07:18 | 只看該作者
本帖最後由 GBKEE 於 2017-11-14 15:24 編輯

回復 1# Scott090
  1. Option Explicit
  2. Dim Sh As Worksheet
  3. Sub Ex_網頁底部()
  4.     Dim E As Object, Er As Integer
  5.     'Dim Timer As Date   'Timer 為vba的內建函數 ,變數名稱盡量不要相同
  6.     Dim xTimer As Date
  7.     Application.DisplayStatusBar = True
  8.     Application.StatusBar = False
  9.     Set Sh = ActiveSheet
  10.     Sh.Cells.Clear
  11.     On Error GoTo EE
  12.     With CreateObject("InternetExplorer.Application")
  13.       '  .Visible = True
  14.         xTimer = Time
  15.         .Navigate "https://finance.yahoo.com/quote/AAPL/history?period1=915206400&period2=1505174400&interval=1d&filter=history&frequency=1d"
  16.         Do While .Busy Or .readyState <> 4: DoEvents: Application.StatusBar = "******  等 候 網 頁 下... " & Time:   Loop
  17.         Do
  18.              Application.StatusBar = "******  資料 下載中..." & Application.Text(Time - xTimer, "   [S]秒") & " ******"
  19.             .document.Parentwindow.scrollBy 0, 37900
  20.             Do While .Busy Or .readyState <> 4: DoEvents:            Loop
  21.             With .document.documentElement
  22.                 ' Debug.Print .scrollTop , .clientHeighT, .scrollHeight  '***計算出 37900為最大值
  23.                 If .scrollTop + .clientHeighT = .scrollHeight Then Exit Do
  24.             End With
  25.             DoEvents
  26.         Loop
  27.         Set E = .document.ALL.TAGS("TABLE")(1)
  28.         Ep .document.ALL.TAGS("TABLE")(1).outerHTML
  29.         Application.StatusBar = "** [" & xTimer & " - " & Time & Application.Text(Time - xTimer, " ] , 計 [S]秒") & " ,下載 共 " & E.Rows.Length - 2 & " 筆資料 完畢 !! **"
  30.         .Quit        '關閉網頁
  31.     End With
  32. Exit Sub
  33. EE:  '程式運行速度大於ie時的措施
  34.     Application.StatusBar = "網頁錯誤等候中...."
  35.     Er = Er + 1
  36.     If Er >= 3 Then Stop
  37.     Application.Wait (Second(Now()) + 2)
  38.     Resume
  39. End Sub
  40. Private Sub Ep(S As String) ' A(A.Length - 1).outerHTML
  41.     With CreateObject("InternetExplorer.Application")
  42.         .Navigate "about:Tabs"
  43.        ' .Visible = True
  44.         .document.body.innerHTML = S
  45.         .ExecWB 17, 2       '  Select All
  46.         .ExecWB 12, 2       '  Copy selection
  47.         With Sh
  48.             .Activate
  49.            ' .Cells.Clear
  50.             .Range("A1").Select
  51.             .PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
  52.             .Range("A1").Select
  53.         End With
  54.         .Quit
  55.     End With
  56. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 不要隨心所欲，要隨心教育自己。
12
返回列表 上一主題