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

t8899

回復  t8899
GBKEE 發表於 2013-9-3 07:59

有無辦法一直處於連線狀態?(像DDE)

GBKEE

回復 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

複製代碼

t8899

回復  t8899
GBKEE 發表於 2013-9-7 06:44

請問在這種狀態下，網站數據更新，工作表也即時更新??是否會太消眊excel資源 (鼠標一直出現漏斗狀)

GBKEE

回復 23# t8899
無言

t8899

把兩個連接對外網路抓資料巨集拿掉，巨集執行完費時不到1秒


Sub zzzzz()

'Application.Interactive = False
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayStatusBar = False
ActiveSheet.DisplayPageBreaks = False
Dim sh As Worksheet
Set sh = ActiveSheet
timestock '==============>連接網路抓取資料匯入工作表, 消眊3秒,鼠標出現漏斗狀
漲跌停  '================>連接網路抓取資料匯入工作表 ,消眊2秒,鼠標出現漏斗狀

Sheets("sheet6").Select

  If Range("H16").Value = 0 Then Run "Aclear"

With Sheets("sheet6")
'A1 時間-------------------------------------------------------------------

Sheets("sheet6").Unprotect

      [A1] = Now
t = [TEXT(A1,"hh:mm")+LOOKUP(--TEXT(A1,"s"),{0,15,30,45})/86400]

Range("a65536").End(xlUp).Offset(1).Value = Format(t, "hh:mm:ss")
      
  Sheets("sheet6").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
      

.Range("Z8").Value = .Range("H16").Value
.Range("Z9").Value = .Range("I16").Value
.Range("B65536").End(xlUp).Offset(1) = .Range("D16").Value   '總委買數量-委賣數量
.Range("O65536").End(xlUp).Offset(1) = .Range("C16").Value   '每筆買
.Range("P65536").End(xlUp).Offset(1) = .Range("C18").Value   '每筆賣
.Range("Q65536").End(xlUp).Offset(1) = .Range("B16").Value   '買進張數
.Range("R65536").End(xlUp).Offset(1) = .Range("B18").Value   '賣出張數
.Range("C65536").End(xlUp).Offset(1) = .Range("H2").Value    '指數漲跌
.Range("W65536").End(xlUp).Offset(1) = .Range("I2").Value    '成交金額
.Range("X65536").End(xlUp).Offset(1) = .Range("B15").Value   '成交張數 OK
.Range("S65536").End(xlUp).Offset(1) = .Range("B17").Value   '總買筆
.Range("T65536").End(xlUp).Offset(1) = .Range("B19").Value   '總賣筆 OK
.Range("AH65536").End(xlUp).Offset(1) = .Range("AE16").Value '漲停買進
.Range("AI65536").End(xlUp).Offset(1) = .Range("AF16").Value '跌停賣出
.Range("Z65536").End(xlUp).Offset(1) = .Range("M2").Value    '韓股
.Range("E65536").End(xlUp).Offset(1) = .Range("H18").Value   '台指價位
.Range("AF65536").End(xlUp).Offset(1) = .Range("U10").Value  '上漲比例
  .Range("AE65536").End(xlUp).Offset(1) = .Range("H12").Value '5檔差
.Range("D65536").End(xlUp).Offset(1) = .Range("I4").Value    '每筆買減賣(累)
.Range("AC65536").End(xlUp).Offset(1) = .Range("B14").Value  '成交筆數
.Range("G65536").End(xlUp).Offset(1) = .Range("G15").Value   '前20檔即時算出與上一盤的點數
.Range("s10:t10").Value = .Range("J2:K2").Value              ' 漲跌比例 (暫存)
'--------------------------------------------------------------------------
End With

'---------------------------------------------------------------------
     
Application.EnableEvents = False
Sheets("Sheet3").Range("Z2:Z111").Value = Sheets("Sheet3").Range("C2:C111").Value
Application.EnableEvents = True
   
'--------------------------------------------------------------
If Sheets("Sheet3").Range("R26").Value = 1 Then
price
end if
     sh.Activate

Application.ScreenUpdating = True
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
' Application.Interactive = True
      
End Sub

GBKEE

回復 1# t8899
上傳整個檔案看看

t8899

回復 2# GBKEE
Book1.rar (60.37 KB)

下載次數: 11

2013-9-9 10:51

GBKEE

回復 27# t8899

1. Sub zzzzz()
   
2. 'Application.Interactive = False
   
3. Application.ScreenUpdating = False
   
4. Application.EnableEvents = False
   
5. Application.DisplayStatusBar = False
   
6. ActiveSheet.DisplayPageBreaks = False
   
7. Dim sh As Worksheet
   
8. Set sh = ActiveSheet
   
9. 'timestock   不要執行
   
10. '漲跌停    不要執行

複製代碼

請看附檔 修改你的程式碼,工作表的公式

Dee.rar (60.17 KB)

下載次數: 11

2013-9-10 15:55

t8899

回復  t8899 請看附檔 修改你的程式碼,工作表的公式
GBKEE 發表於 2013-9-10 15:12

附檔裡沒有 BOOK2 .XLS ?

t8899

回復  t8899 請看附檔 修改你的程式碼,工作表的公式
GBKEE 發表於 2013-9-10 15:12

不知我做的對不對??
三個excel 獨立視窗各自在跑??另外兩個視窗可否隱藏?