[發問] 處理一定時間 中斷執行

li_hsien

最近在用QueryTable 連網站抓資料

因為有使用到迴圈來處理

所以執行上有點緩慢

有時候如果資料量太大
Excel會跑超久

請問各位大大

能否在執行過程中加入一個經過時間的計算

如果處理時間超過一定時間  則先中斷取消執行

不知能否這樣處理


謝謝

GBKEE

有時候如果資料量太大
Excel會跑超久
li_hsien 發表於 2014/9/1 11:45

附檔看看,是否有改善空間,可縮短程式運行時間.

li_hsien

回復 2# GBKEE

下方的page_no是用來換頁

因為頁面一次僅能顯示100筆

但有的查詢結果會大於100筆

後來我發現網址中會有個pageoffset
如果pageoffset=100，則會換頁，顯示第101~200筆

所以我的作法用個迴圈讓pageoffset +100
一直換頁到筆數跟上一次一樣，即代表最後一頁了，則停止執行。

1. Sub Search_Click()
   
2. 
   
3.     Dim Key_URL As String
   
4.     Dim start_row As Integer
   
5.     Dim flag_row As Integer
   
6.     Dim page_no As Integer
   
7.         
   
8.     '多頁切換
   
9.     page_no = 0
   
10.     '起始欄位
    
11.     start_row = 2
    
12.    
    
13.     '如果一直換頁 換到沒有筆數時 則停止(開始比數=結束比數 未增加)
    
14.     Do Until (start_row = flag_row)
    
15.    
    
16.         start_row = Worksheets("BC Data").Range("C65536").End(xlUp).Row + 1
    
17.         
    
18.            Key_URL= "URL;http:// *****  & "pageoffset=" & page_no
    
19.    
    
20.             With Worksheets("BC Data").QueryTables.Add(Connection:=Key_URL, _
    
21.                 Destination:=Worksheets("BC Data").Range("A" & start_row))
    
22.                 .WebSelectionType = xlSpecifiedTables
    
23.                 .WebFormatting = xlWebFormattingNone
    
24.                 .WebTables = "5"
    
25.                 .WebPreFormattedTextToColumns = True
    
26.                 .WebConsecutiveDelimitersAsOne = True
    
27.                 .WebSingleBlockTextImport = False
    
28.                 .WebDisableDateRecognition = False
    
29.                 .WebDisableRedirections = False
    
30.                 .Refresh BackgroundQuery:=False
    
31.                 .Delete
    
32.             End With
    
33.    
    
34.         '一頁面100筆 執行完換頁
    
35.         page_no = page_no + 100
    
36.         
    
37.         '去標頭
    
38.         Worksheets("BC Data").Rows(start_row).Delete
    
39.         
    
40.         '紀錄最末比
    
41.         flag_row = Worksheets("BC Data").Range("C65536").End(xlUp).Row + 1
    
42.         
    
43.         '如果<100筆 執行一次結束即可
    
44.         If Worksheets("BC Data").Range("C65536").End(xlUp).Row < 201 Then Exit Sub
    
45.    
    
46.     Loop
    
47.    
    
48. '    Debug.Print page_no
    
49.    
    
50. End Sub

複製代碼

P.S. 因為是公司內部網站，所以我以*****取代。

GBKEE

回復 3# li_hsien
試試看

1. Sub Search_Click()
   
2.     Dim Key_URL As String, T As Date  '*****
   
3.     Dim start_row As Integer
   
4.     Dim flag_row As Integer
   
5.     Dim page_no As Integer
   
6.     T = Time  '程式執行開始時間       '******
   
7.         
   
8.     '多頁切換
   
9.     page_no = 0
   
10.     '起始欄位
    
11.     start_row = 2
    
12.    
    
13.     '如果一直換頁 換到沒有筆數時 則停止(開始比數=結束比數 未增加)
    
14.     Do Until (start_row = flag_row)
    
15.         If Time > T + #12:10:00 AM# Then Exit Sub   '程式執行超過10分,離開程式
    
16.         start_row = Worksheets("BC Data").Range("C65536").End(xlUp).Row + 1
    
17.         Key_URL= "URL;http:// *****  & "pageoffset=" & page_no
    
18.         
    
19.         With Worksheets("BC Data").QueryTables.Add(Connection:=Key_URL, _
    
20.                 Destination:=Worksheets("BC Data").Range("A" & start_row))

複製代碼

li_hsien

回復 4# GBKEE

感謝版大協助 !!!

所以我目前的程式碼

在處理效率上是否還有改善空間呢 ???

謝謝

GBKEE

回復 5# li_hsien
因你這是內部網頁,看不到原始檔,所以不知如何改善.

li_hsien

回復 6# GBKEE

感謝版大幫助

我再想想能否提供相關原始碼

還是局部的原始碼

謝謝

GBKEE

回復 7# li_hsien

下載 (56.19 KB)

2014-9-6 14:47

如網頁上有這總頁數,可抓取這總頁數來跑迴圈.

li_hsien

回復 8# GBKEE

請教一下版大

下方是我截取部分跟頁數有關的原始碼

但我不知道該如何抓取總頁數(11)

1. <SCRIPT LANGUAGE="JavaScript1.1">
   
2. <!--
   
3. function goToPage(s) {
   
4.    var thisForm = window.document.forms[0];
   
5.    var page_n = 11;
   
6.    var page_range = 100;
   
7.    var box_name = "go_to_page" + s;
   
8.    var search_link = **********;
   
9.    for (var i=0; i < thisForm.elements.length; i++) {
   
10.       var nextElement = thisForm.elements[i];
    
11.       if (nextElement.name == box_name) {
    
12.          go_to_page = nextElement.value;
    
13.       }
    
14.    }
    
15.    if (go_to_page == null || go_to_page == 0) {
    
16.       alert("您必須輸入 1 到 11 之間的其中一個頁碼。");
    
17.    }
    
18.    else if (1 <= go_to_page && go_to_page <= page_n) {
    
19.       var offset = (go_to_page - 1) * page_range
    
20.       location.href = search_link + offset;
    
21.    }
    
22.    else {
    
23.       alert("您必須輸入 1 到 11 之間的其中一個頁碼。");
    
24.    }
    
25. }
    
26. //end hiding -->
    
27. </SCRIPT>
    
28. &nbsp;<P><B>
    
29. 第 1 頁，共 11 頁<A HREF=**********>>></A>

複製代碼

煩請版大解惑

謝謝!!!

GBKEE

回復 9# li_hsien

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim URL As String, A As Object, B As String
   
4.     URL = "d:\aaa.htm"  '你內部網頁的網址
   
5.     With CreateObject("InternetExplorer.Application")
   
6.         .Navigate URL
   
7.         .Visible = True
   
8.         Do While .Busy Or .readyState <> 4:         Loop
   
9.         Set A = .document.getElementsByTagName("b").Item(0)
   
10.         '你這網頁只看到一個 <B>  的Element元素,所以是Item(0)第一個
    
11.         B = A.innertext    '"第 1 頁，共 11 頁>>"
    
12.         B = Trim(Mid(B, InStr(B, "共") + 1, InStrRev(B, "頁") - InStr(B, "共") - 1))
    
13.         
    
14.         'LTrim、RTrim 與 Trim 函數
    
15.         '傳回一個沒有前頭空白 (LTrim)、後面空白 (RTrim) 或前後均無空白的Variant (String)，其中所含為給定的字串。
    
16.         
    
17.         'InStr 函數
    
18.         '傳回在某字串中一字串的最先出現位置，此位置為 Variant (Long)。
    
19.         
    
20.         'InStrRev函數
    
21.         '傳回一個字串在另一個字串中出現的位置，從字串的末尾算起。
    
22.         
    
23.         MsgBox B
    
24.         .Quit
    
25.     End With
    
26. End Sub

複製代碼