ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] ºô­¶¸ê®Æ«Üªø¡A¦p¦ó¦³®Ä²v¦aª¾¹D¤w§¹¾ã¶i¨Ó

¥»©«³Ì«á¥Ñ GBKEE ©ó 2017-11-14 15:24 ½s¿è

¦^´_ 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ªº¤º«Ø¨ç¼Æ ,ÅܼƦWºÙºÉ¶q¤£­n¬Û¦P
  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 = "******  µ¥ ­Ô ºô ­¶ ¤U... " & Time:   Loop
  17.         Do
  18.              Application.StatusBar = "******  ¸ê®Æ ¤U¸ü¤¤..." & 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  '***­pºâ¥X 37900¬°³Ì¤j­È
  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, " ] , ­p [S]¬í") & " ,¤U¸ü ¦@ " & E.Rows.Length - 2 & " µ§¸ê®Æ §¹²¦ !! **"
  30.         .Quit        'Ãö³¬ºô­¶
  31.     End With
  32. Exit Sub
  33. EE:  'µ{¦¡¹B¦æ³t«×¤j©óie®Éªº±¹¬I
  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
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 3# Scott090

°Ñ¦Ò³o¸Ì  http://www.jb51.net/article/57614.htm
2# ªºµ{¦¡½X­×§ï¤F¬°
  1. With .document.documentElement
  2.                 ' Debug.Print .scrollTop , .clientHeighT, .scrollHeight  '***­pºâ¥X 37900¬°³Ì¤j­È
  3.                 If .scrollTop + .clientHeighT = .scrollHeight Then Exit Do
  4.             End With
½Æ»s¥N½X
¦ý´ú¸Õ®É,.°¸º¸ÁÙ¬O¤£¯à§¹¥þ¤U¸ü,¦³«Ý§V¤O
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 6# Scott090
¤£¿ùªº³o¼Ë´N¥i¥H±o¨ì§¹¾ã¸ê®Æ.
µ{¦¡°õ¦æ®É¶¡¤j¬ù»Ý¤@¤ÀÄÁ,§Ú¾ã²z¤@¤U¦bª¬ºA¦C¤W¥[¤W¸ê°T.
  1. Option Explicit
  2. Dim Sh As Worksheet
  3. Dim xTimer As Date
  4. 'Dim Timer As Date   'Timer ¬°vbaªº¤º«Ø¨ç¼Æ ,ÅܼƦWºÙºÉ¶q¤£­n¬Û¦P
  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 = "******  µ¥ ­Ô ºô ­¶ ¤U....¡¹¡¹¡¹" & GetTime:  Loop
  17.         Ie_Date = Getdate(.document.ALL.TAGS("INPUT")(4).Value)
  18.         Set E = .document.ALL.TAGS("tr")
  19.        Do
  20.             Application.StatusBar = "¡¹¡¹¡¹¡¹¡¹  ¸ê®Æ ¤U¸ü¤¤..." & 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 & " ,¤U¸ü ¦@ " & 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:  'µ{¦¡¹B¦æ³t«×¤j©óie®Éªº±¹¬I
  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
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

        ÀR«ä¦Û¦b : Ä@­n¤j¡B§Ó­n°í¡B®ð­n¬X¡B¤ß­n²Ó¡C
ªð¦^¦Cªí ¤W¤@¥DÃD