返回列表 上一主題 發帖

[發問] 連接網路抓取資料匯入工作表速度慢?有無辦法改善?

回復 1# t8899
  1. Sub Ex()
  2.     Dim xlVbTable As Object, Ar, R As Integer, C As Integer, i As Variant, Y As Integer
  3.     With CreateObject("InternetExplorer.Application")
  4.         .Visible = True
  5.        .Navigate "http://udn.megatime.com.tw/asp/hot/ShortOperate.asp?lcount=20&m=puplim&align=v"
  6.         Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
  7.         Set xlVbTable = .document.getelementsbytagname("table")
  8.         On Error Resume Next
  9.         With ActiveSheet
  10.             .Cells.Clear
  11.             .Cells(1, 1) = "漲停鎖死股"
  12.             Y = 2
  13.             For Each i In Array(20, 24)
  14.                 If i = 24 Then .Cells(Y, 1) = "跌停鎖死股": Y = Y + 1
  15.                 For R = 0 To xlVbTable(i).Rows.Length - 1
  16.                     For C = 0 To xlVbTable(i).Rows(1).ALL.Length - 1
  17.                         .Cells(Y, C + 1) = xlVbTable(i).Rows(R).Cells(C).innerText
  18.                     Next
  19.                     Y = Y + 1
  20.                 Next
  21.             Next
  22.             .Rows(13).Delete
  23.         End With
  24.        .Quit
  25.     End With
  26. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 3# t8899
討論區裡有許多類似的討論,自己試著刪看看.
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

本帖最後由 GBKEE 於 2013-9-4 12:37 編輯

回復 5# t8899
多練習一下VBA就會進步(不會並不一定要問人的)
  1. Option Explicit
  2. Sub Ex()
  3.     Dim xlVbTable As Object, Ar, R As Integer, C As Integer, i As Variant, Y As Integer
  4.     Dim t As Date
  5.     t = Time
  6.     With CreateObject("InternetExplorer.Application")
  7.        ' .Visible = True
  8.        .Navigate "http://udn.megatime.com.tw/asp/hot/ShortOperate.asp?lcount=20&m=puplim&align=v"
  9.         Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
  10.         Set xlVbTable = .document.getelementsbytagname("table")
  11.         On Error Resume Next
  12.         With ActiveSheet
  13.             .Cells = ""
  14.             .Cells(1, 1) = "漲停鎖死股"
  15.             For Each i In Array(20, 24)
  16.                 If i = 24 Then .Cells(1, "J") = "跌停鎖死股"
  17.                 Y = 2
  18.                 For R = 0 To xlVbTable(i).Rows.Length - 1
  19.                     For C = 0 To xlVbTable(i).Rows(1).ALL.Length - 1
  20.                         .Cells(Y, C + IIf(i = 20, 1, 10)) = xlVbTable(i).Rows(R).Cells(C).innerText
  21.                         'IIf(i = 20, 1, 10) ->  1:="A", 10:="J"
  22.                     Next
  23.                     Y = Y + 1
  24.                 Next
  25.                 If i = 20 Then .Rows(13).Delete
  26.             Next
  27.         End With
  28.        .Quit
  29.     End With
  30.     MsgBox Application.Text(Time - t, "費時 [ss] 秒")
  31. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

本帖最後由 GBKEE 於 2013-9-4 09:00 編輯

回復 8# t8899
.Cells.Clear 改成->.Cells="" 試試看
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

本帖最後由 GBKEE 於 2013-9-4 09:55 編輯

回復 10# t8899
這語法上的錯誤,(手誤,9#的內容已修正)可試著修改.
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 13# t8899
大約1 分鐘更新一次,沒那麼慢吧! (定時清除將你pc上的暫存檔,還有刪除ie上瀏灠紀錄,速度會快很多)
試試 6# 更新的程式碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 15# t8899
是這樣嗎?
  1. Option Explicit
  2. Sub Ex()
  3.     Dim xlVbTable As Object, Ar, R As Integer, C As Integer, i As Variant, Y As Integer
  4.     Dim t As Date, Msg As Boolean
  5.     t = Time
  6.     With CreateObject("InternetExplorer.Application")
  7.        ' .Visible = True
  8.        .Navigate "http://udn.megatime.com.tw/asp/hot/ShortOperate.asp?lcount=20&m=puplim&align=v"
  9.         Do While (.Busy Or .ReadyState <> 4) And Msg = False
  10.              DoEvents
  11.              If Time > t + #12:00:05 AM# Then Msg = True
  12.         Loop
  13.          On Error Resume Next
  14.         If Msg = True Then
  15.             .Quit
  16.             MsgBox "連線的時間超過5秒"
  17.         Else
  18.             Set xlVbTable = .document.getelementsbytagname("table")
  19.             With Sheets("Sheet5")
  20.                 .Cells = ""
  21.                 .Cells(1, 1) = "漲停鎖死股"
  22.                 For Each i In Array(20, 24)
  23.                     If i = 24 Then .Cells(1, "J") = "跌停鎖死股"
  24.                     Y = 2
  25.                     For R = 0 To xlVbTable(i).Rows.Length - 1
  26.                         For C = 0 To xlVbTable(i).Rows(1).ALL.Length - 1
  27.                             .Cells(Y, C + IIf(i = 20, 1, 10)) = xlVbTable(i).Rows(R).Cells(C).innerText
  28.                             'IIf(i = 20, 1, 10) ->  1:="A", 10:="J"
  29.                         Next
  30.                         Y = Y + 1
  31.                     Next
  32.                     If i = 20 Then .Rows(13).Delete   '貼上連結的儲存格仍然是#REF!->儲存格被刪除掉
  33.                 Next
  34.             End With
  35.             .Quit
  36.             Sheets("Sheet3").[I4:I22] = "=SHEET5!RC[-6]" '貼上連結的儲存格仍
  37.             MsgBox Application.Text(Time - t, "費時 [ss] 秒")            
  38.         End If
  39.     End With
  40. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 17# t8899
Rows(13).Delete   ->第13列



詳看  FormulaR1C1, Rows  的VBA 說明
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 19# t8899
試試看不就知道.
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

本帖最後由 GBKEE 於 2013-9-7 06:45 編輯

回復 21# t8899
  1. Option Explicit
  2. Private Sub Ex()
  3.     Dim xlVbTable As Object, Ar, R As Integer, C As Integer, i As Variant, Y As Integer
  4.     Dim t As Date, Msg As Boolean
  5.    ' Application.OnTime Time + #12:01:00 AM#, "Ex"   '一分鐘後執行 Ex 程式
  6.     Application.OnTime Time + #12:01:00 AM#, "SHEET5.Ex"   '一分鐘後執行 Ex 程式
  7.     '程式在物件模組中要指明模組名稱 , Private Sub(私用程式)在一般模組中也要指明 一般模組名稱
  8.     Application.DisplayStatusBar = True                     '顯示狀態列
  9.     t = Time
  10.     With CreateObject("InternetExplorer.Application")
  11.       '  .Visible = True
  12.        .Navigate "http://udn.megatime.com.tw/asp/hot/ShortOperate.asp?lcount=20&m=puplim&align=v"
  13.         Do While (.Busy Or .ReadyState <> 4) And Msg = False
  14.              DoEvents
  15.              If Time > t + #12:00:05 AM# Then Msg = True
  16.         Loop
  17.         If Msg = True Then
  18.             .Quit
  19.             'MsgBox "連線的時間超過5秒"
  20.             Application.StatusBar = "連線失敗   連線的時間超過5秒"
  21.         Else
  22.             Set xlVbTable = .document.getelementsbytagname("table")
  23.              On Error Resume Next
  24.             With Sheets("Sheet5")
  25.                 .Cells = ""
  26.                 .Cells(1, 1) = "漲停鎖死股"
  27.                 For Each i In Array(20, 24)
  28.                     If i = 24 Then .Cells(1, "J") = "跌停鎖死股"
  29.                     Y = 2
  30.                     For R = 0 To xlVbTable(i).Rows.Length - 1
  31.                         For C = 0 To xlVbTable(i).Rows(1).ALL.Length - 1
  32.                             .Cells(Y, C + IIf(i = 20, 1, 10)) = xlVbTable(i).Rows(R).Cells(C).innerText
  33.                             'IIf(i = 20, 1, 10) ->  1:="A", 10:="J"
  34.                         Next
  35.                         Y = Y + 1
  36.                     Next
  37.                     If i = 20 Then .Rows(13).Delete   '貼上連結的儲存格仍然是#REF!->儲存格被刪除掉
  38.                 Next
  39.             End With
  40.             .Quit
  41.             Sheets("Sheet3").[I4:I22] = "=SHEET5!RC[-6]" '貼上連結的儲存格仍
  42.             'MsgBox Application.Text(Time - t, "費時 [ss] 秒")
  43.             Application.StatusBar = "連線成功   更新時間 " & Format(Time, "HH:MM:SS")
  44.         End If
  45.     End With
  46. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 知識要用心體會,才能變成自己的智慧。
返回列表 上一主題