麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 連接網路抓取資料匯入工作表速度慢?有無辦法改善? [打印本頁]

作者: t8899 時間: 2013-9-3 07:06 標題: 請問此網頁有無辦法匯入excel ?

http://udn.megatime.com.tw/asp/hot/ShortOperate.asp?lcount=20&m=puplim&align=v

作者: GBKEE 時間: 2013-9-3 07:59

回復 1# t8899

Sub Ex()
Dim xlVbTable As Object, Ar, R As Integer, C As Integer, i As Variant, Y As Integer
With CreateObject("InternetExplorer.Application")
.Visible = True
.Navigate "http://udn.megatime.com.tw/asp/hot/ShortOperate.asp?lcount=20&m=puplim&align=v"
Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
Set xlVbTable = .document.getelementsbytagname("table")
On Error Resume Next
With ActiveSheet
.Cells.Clear
.Cells(1, 1) = "漲停鎖死股"
Y = 2
For Each i In Array(20, 24)
If i = 24 Then .Cells(Y, 1) = "跌停鎖死股": Y = Y + 1
For R = 0 To xlVbTable(i).Rows.Length - 1
For C = 0 To xlVbTable(i).Rows(1).ALL.Length - 1
.Cells(Y, C + 1) = xlVbTable(i).Rows(R).Cells(C).innerText
Next
Y = Y + 1
Next
Next
.Rows(13).Delete
End With
.Quit
End With
End Sub

複製代碼

作者: t8899 時間: 2013-9-3 10:41

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

請問不想看到ie8 出現要刪掉那一行呢?

作者: GBKEE 時間: 2013-9-3 10:55

回復 3# t8899
討論區裡有許多類似的討論,自己試著刪看看.

作者: t8899 時間: 2013-9-3 12:16

回復 t8899
討論區裡有許多類似的討論,自己試著刪看看.
GBKEE 發表於 2013-9-3 10:55

我是改 CreateObject("InternetExplorer.Application") .Visible = FALSE

可以將"跌停鎖死股" 從 J1 開始排嗎??

作者: GBKEE 時間: 2013-9-3 13:03

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

回復 5# t8899
多練習一下VBA就會進步(不會並不一定要問人的)

Option Explicit
Sub Ex()
Dim xlVbTable As Object, Ar, R As Integer, C As Integer, i As Variant, Y As Integer
Dim t As Date
t = Time
With CreateObject("InternetExplorer.Application")
' .Visible = True
.Navigate "http://udn.megatime.com.tw/asp/hot/ShortOperate.asp?lcount=20&m=puplim&align=v"
Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
Set xlVbTable = .document.getelementsbytagname("table")
On Error Resume Next
With ActiveSheet
.Cells = ""
.Cells(1, 1) = "漲停鎖死股"
For Each i In Array(20, 24)
If i = 24 Then .Cells(1, "J") = "跌停鎖死股"
Y = 2
For R = 0 To xlVbTable(i).Rows.Length - 1
For C = 0 To xlVbTable(i).Rows(1).ALL.Length - 1
.Cells(Y, C + IIf(i = 20, 1, 10)) = xlVbTable(i).Rows(R).Cells(C).innerText
'IIf(i = 20, 1, 10) -> 1:="A", 10:="J"
Next
Y = Y + 1
Next
If i = 20 Then .Rows(13).Delete
Next
End With
.Quit
End With
MsgBox Application.Text(Time - t, "費時 [ss] 秒")
End Sub

複製代碼

作者: t8899 時間: 2013-9-3 20:20

本帖最後由 t8899 於 2013-9-3 20:33 編輯

回復 6# GBKEE
謝謝!再請教一下
當我在重新更新後,參照此表的儲存格(貼上連結)有些會出現 #REF!，需重新設定儲存格參照才會恢復正常, 有無辦法解決?
=漲跌停!C12
更新後 ===> =漲跌停!#REF!
[attach]15929[/attach]

作者: t8899 時間: 2013-9-3 21:17

本帖最後由 t8899 於 2013-9-3 21:19 編輯

想到一個辦法
直接在您寫的巨集之後加上
Sheets("試算").Range("P3:P56").Value = Sheets("漲跌停").Range("G3:G56").Value
Sheets("試算").Range("O3:O56").Value = Sheets("漲跌停").Range("C3:C56").Value
Sheets("試算").Range("Q3:Q56").Value = Sheets("漲跌停").Range("P3:P56").Value
Sheets("試算").Range("R3:R56").Value = Sheets("漲跌停").Range("L3:L56").Value

作者: GBKEE 時間: 2013-9-4 07:14

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

回復 8# t8899
.Cells.Clear 改成->.Cells="" 試試看

作者: t8899 時間: 2013-9-4 08:54

回復 t8899
.Cells.Clear 改成->.Cells.="" 試試看
GBKEE 發表於 2013-9-4 07:14

語法錯誤?
[attach]15930[/attach]

作者: GBKEE 時間: 2013-9-4 09:03

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

回復 10# t8899
這語法上的錯誤,(手誤,9#的內容已修正)可試著修改.

作者: t8899 時間: 2013-9-4 09:46

回復 t8899
這語法上的錯誤,(手誤,9#已修正)可試著修改.
GBKEE 發表於 2013-9-4 09:03

9# 是 ??

作者: t8899 時間: 2013-9-4 10:19

回復 t8899
這語法上的錯誤,(手誤,9#的內容已修正)可試著修改.
GBKEE 發表於 2013-9-4 09:03

試了一個小時，大約1 分鐘更新一次，中間excel 卡住兩次沒反應?
是否連線無法成功造成?可否改成5秒沒連上就程式就跳出?

作者: GBKEE 時間: 2013-9-4 12:57

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

[attach]15936[/attach]

作者: t8899 時間: 2013-9-4 14:45

語法錯誤?
t8899 發表於 2013-9-4 08:54

大約1 分鐘更新一次,沒那麼慢吧

我指的一分鐘是我設定每1分鐘跑一次巨集,(不是程式跑一次要1分鐘)
等於跑了60次，excel 中途當了兩次
是否連線的關系?如果是可否改成5秒連不成就跳出?

.Cells.Clear 改成->.Cells="" 試試看

六樓程式碼重新跑了兩次，貼上連結的儲存格仍然是#REF!
附檔[attach]15938[/attach]

作者: GBKEE 時間: 2013-9-4 16:55

回復 15# t8899
是這樣嗎?

Option Explicit
Sub Ex()
Dim xlVbTable As Object, Ar, R As Integer, C As Integer, i As Variant, Y As Integer
Dim t As Date, Msg As Boolean
t = Time
With CreateObject("InternetExplorer.Application")
' .Visible = True
.Navigate "http://udn.megatime.com.tw/asp/hot/ShortOperate.asp?lcount=20&m=puplim&align=v"
Do While (.Busy Or .ReadyState <> 4) And Msg = False
DoEvents
If Time > t + #12:00:05 AM# Then Msg = True
Loop
On Error Resume Next
If Msg = True Then
.Quit
MsgBox "連線的時間超過5秒"
Else
Set xlVbTable = .document.getelementsbytagname("table")
With Sheets("Sheet5")
.Cells = ""
.Cells(1, 1) = "漲停鎖死股"
For Each i In Array(20, 24)
If i = 24 Then .Cells(1, "J") = "跌停鎖死股"
Y = 2
For R = 0 To xlVbTable(i).Rows.Length - 1
For C = 0 To xlVbTable(i).Rows(1).ALL.Length - 1
.Cells(Y, C + IIf(i = 20, 1, 10)) = xlVbTable(i).Rows(R).Cells(C).innerText
'IIf(i = 20, 1, 10) -> 1:="A", 10:="J"
Next
Y = Y + 1
Next
If i = 20 Then .Rows(13).Delete '貼上連結的儲存格仍然是#REF!->儲存格被刪除掉
Next
End With
.Quit
Sheets("Sheet3").[I4:I22] = "=SHEET5!RC[-6]" '貼上連結的儲存格仍
MsgBox Application.Text(Time - t, "費時 [ss] 秒")
End If
End With
End Sub

複製代碼

作者: t8899 時間: 2013-9-4 18:54

回復 t8899
是這樣嗎?
GBKEE 發表於 2013-9-4 16:55

嗯, 完美無缺.
抱歉小弟vb 剛初學

If i = 20 Then .Rows(13).Delete

這是delete sheet5的那一個?

Sheets("Sheet3").[I4:I22] = "=SHEET5!RC[-6]"

RC[-6] ===>是指??

作者: GBKEE 時間: 2013-9-4 21:06

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

[attach]15939[/attach]

詳看 FormulaR1C1, Rows 的VBA 說明

作者: t8899 時間: 2013-9-5 06:13

本帖最後由 t8899 於 2013-9-5 06:18 編輯

回復 t8899
Rows(13).Delete ->第13列詳看 FormulaR1C1, Rows 的VBA 說明
GBKEE 發表於 2013-9-4 21:06

謝謝!
另外請教一下,下面宣告如何改為公用?
Private Declare Function MsgBoxTest Lib "user32" Alias "MessageBoxTimeoutA" ( _
是將 private 改為 public 就可以了嗎?

作者: GBKEE 時間: 2013-9-5 06:41

回復 19# t8899
試試看不就知道.

作者: t8899 時間: 2013-9-6 21:54

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

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

作者: GBKEE 時間: 2013-9-7 06:44

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

回復 21# t8899

Option Explicit
Private Sub Ex()
Dim xlVbTable As Object, Ar, R As Integer, C As Integer, i As Variant, Y As Integer
Dim t As Date, Msg As Boolean
' Application.OnTime Time + #12:01:00 AM#, "Ex" '一分鐘後執行 Ex 程式
Application.OnTime Time + #12:01:00 AM#, "SHEET5.Ex" '一分鐘後執行 Ex 程式
'程式在物件模組中要指明模組名稱 , Private Sub(私用程式)在一般模組中也要指明一般模組名稱
Application.DisplayStatusBar = True '顯示狀態列
t = Time
With CreateObject("InternetExplorer.Application")
' .Visible = True
.Navigate "http://udn.megatime.com.tw/asp/hot/ShortOperate.asp?lcount=20&m=puplim&align=v"
Do While (.Busy Or .ReadyState <> 4) And Msg = False
DoEvents
If Time > t + #12:00:05 AM# Then Msg = True
Loop
If Msg = True Then
.Quit
'MsgBox "連線的時間超過5秒"
Application.StatusBar = "連線失敗連線的時間超過5秒"
Else
Set xlVbTable = .document.getelementsbytagname("table")
On Error Resume Next
With Sheets("Sheet5")
.Cells = ""
.Cells(1, 1) = "漲停鎖死股"
For Each i In Array(20, 24)
If i = 24 Then .Cells(1, "J") = "跌停鎖死股"
Y = 2
For R = 0 To xlVbTable(i).Rows.Length - 1
For C = 0 To xlVbTable(i).Rows(1).ALL.Length - 1
.Cells(Y, C + IIf(i = 20, 1, 10)) = xlVbTable(i).Rows(R).Cells(C).innerText
'IIf(i = 20, 1, 10) -> 1:="A", 10:="J"
Next
Y = Y + 1
Next
If i = 20 Then .Rows(13).Delete '貼上連結的儲存格仍然是#REF!->儲存格被刪除掉
Next
End With
.Quit
Sheets("Sheet3").[I4:I22] = "=SHEET5!RC[-6]" '貼上連結的儲存格仍
'MsgBox Application.Text(Time - t, "費時 [ss] 秒")
Application.StatusBar = "連線成功更新時間 " & Format(Time, "HH:MM:SS")
End If
End With
End Sub

複製代碼

作者: t8899 時間: 2013-9-7 07:20

本帖最後由 t8899 於 2013-9-7 07:25 編輯

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

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

作者: GBKEE 時間: 2013-9-7 08:11

回復 23# t8899
無言

作者: t8899 時間: 2013-9-9 05:55 標題: 連接網路抓取資料匯入工作表速度慢?有無辦法改善?

本帖最後由 t8899 於 2013-9-9 06:08 編輯

把兩個連接對外網路抓資料巨集拿掉，巨集執行完費時不到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 時間: 2013-9-9 08:02

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

作者: t8899 時間: 2013-9-9 10:51

回復 2# GBKEE
[attach]15986[/attach]

作者: GBKEE 時間: 2013-9-10 15:12

本帖最後由 GBKEE 於 2013-9-10 15:55 編輯

回復 27# t8899

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 不要執行
'漲跌停不要執行

複製代碼

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

[attach]16005[/attach]

作者: t8899 時間: 2013-9-10 15:39

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

附檔裡沒有 BOOK2 .XLS ?

作者: t8899 時間: 2013-9-10 18:32

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

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

作者: t8899 時間: 2013-9-11 03:32

本帖最後由 t8899 於 2013-9-11 03:34 編輯

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

Application.OnTime Time + #12:00:15 AM#, "ThisWorkbook.EX"
12:00:15 ===>凌晨12:00:15 開始更新?? 15秒更新一次??
可否改為 12:00:05 開始更新?15秒更新一次? (即 12:00:05，12:00:20, 12:00:35....)

這兩個巨集可否放在同一個活頁簿?(少一個excel ,較省資源)

隱藏視窗已找到 "HiddeX " 解決 ( http://dejavu.narod.ru/hiddex.html )

作者: GBKEE 時間: 2013-9-11 06:16

回復 31# t8899
12:00:15 ===>凌晨12:00:15 開始更新?? 15秒更新一次?? 對的類推 #00:00:01# 1秒鐘, #00:01# 1分鐘
這兩個巨集可否放在同一個活頁簿?(少一個excel ,較省資源) 試試看啊,Dee的檔案中結合2個程序

Option Explicit
Sub TwOSub()
Application.OnTime Time + #12:00:01 AM#, "twosub"
SUB_A
SUB_B
End Sub

複製代碼

作者: handsometrowa 時間: 2013-9-11 09:51

回復 2# GBKEE

請益G大

關於這個物件 With CreateObject("InternetExplorer.Application")

有沒有更詳細一點的說明，可以學習的呢? 我有上內建解說，似乎對這個物件沒有做解釋

這個是不是屬於ActiveX的範疇呢@@?

作者: GBKEE 時間: 2013-9-11 10:16

回復 33# handsometrowa
網路搜尋 CreateObject("InternetExplorer.Application") 有許多可慢慢了解

作者: handsometrowa 時間: 2013-9-11 11:09

回復 handsometrowa
網路搜尋 CreateObject("InternetExplorer.Application") 有許多可慢慢了解
GBKEE 發表於 2013-9-11 10:16

感謝G大的指導，
另外我在網路爬文，發現MSDN 很多關於這個物件的敘述似乎有點難查詢
對岸的朋友有以下的紀錄網頁

以下轉載
http://blog.csdn.net/darkread/article/details/7241098
(感謝分享)

我覺得寫的很詳細，雖然他也是從MSDN上抓下來的，不過對於開啟網頁物件有很詳細的說明。
爬一下文應該知道自己要找哪些東西。
希望大家都能在IE物件上多加強^^

作者: t8899 時間: 2013-9-12 18:44

本帖最後由 t8899 於 2013-9-12 18:49 編輯

回復 32# GBKEE

For Each i In Array(20, 24)
陣列 20 ,24===> 如何算出?

作者: GBKEE 時間: 2013-9-12 20:32

回復 36# t8899

這裡有圖解

作者: t8899 時間: 2013-9-13 15:50

回復 t8899
GBKEE 發表於 2013-9-12 20:32

用IE 連接 http://udn.megatime.com.tw/asp/hot/ShortOperate.asp?lcount=20&m=puplim&align=v
按右鍵匯出至 Microsoft Excel
出現
[attach]16067[/attach]

作者: GBKEE 時間: 2013-9-13 16:16

回復 38# t8899
按確定後,照圖示再做下去看看

作者: t8899 時間: 2013-9-13 19:38

回復 t8899
按確定後,照圖示再做下去看看
GBKEE 發表於 2013-9-13 16:16

Selection=23,24 ' 須減 1 , 22,23 請看 http://forum.twbts.com/thread-10361-1-1.html

為何要減1??
http://forum.twbts.com/thread-10361-1-1.html =====>無此主題??
指定的主題不存在或已被刪除或正在被審核，請返回

作者: GBKEE 時間: 2013-9-13 21:14

回復 40# t8899
這網址就是你這主題的網址,因合併兩主題而改了網址,所以不見了.
'http://udn.megatime.com.tw/asp/hot/ShortOperate.asp?lcount=20&m=puplim&align=v"
匯到excel後存為查詢檔,如圖

[attach]16069[/attach]

存為查詢檔內容

WEB
1
http://udn.megatime.com.tw/asp/hot/ShortOperate.asp?lcount=20&m=puplim&align=v
Selection=21,25 ' 減 -1 -> 2#的程式碼有 For Each i In Array(20, 24)
Formatting=None
PreFormattedTextToColumns=True
ConsecutiveDelimitersAsOne=True
SingleBlockTextImport=False
DisableDateRecognition=False
DisableRedirections=False

複製代碼

作者: joey0415 時間: 2013-9-17 21:45

將'http://udn.megatime.com.tw/asp/hot/ShortOperate.asp?lcount=20&m=puplim&align=v
另存網頁

用excel 匯入外部資料=>匯入資料=>選擇你存下來的網頁，並勾選你要的部份
以上面的網頁而言就是21,25

我不會算，我只會這樣用，你參考參考看看
[attach]16095[/attach]

[attach]16096[/attach]

[attach]16097[/attach]

作者: t8899 時間: 2013-9-18 06:27

將'http://udn.megatime.com.tw/asp/hot/ShortOperate.asp?lcount=20&m=puplim&align=v
另存網頁

用exc ...
joey0415 發表於 2013-9-17 21:45

請問 21,25 是怎麼算出來的?

作者: joey0415 時間: 2013-9-18 10:26

回復 43# t8899

你上看一篇！我是下載網頁檔，用錄的就出來了，不用算！

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)