返回列表 上一主題 發帖

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

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

最近在用QueryTable 連網站抓資料

因為有使用到迴圈來處理

所以執行上有點緩慢

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

請問各位大大

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

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

不知能否這樣處理


謝謝
用功到世界末日那一天∼∼∼

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

附檔看看,是否有改善空間,可縮短程式運行時間.
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 2# GBKEE

下方的page_no是用來換頁

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

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

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

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

  2.     Dim Key_URL As String
  3.     Dim start_row As Integer
  4.     Dim flag_row As Integer
  5.     Dim page_no As Integer
  6.         
  7.     '多頁切換
  8.     page_no = 0
  9.     '起始欄位
  10.     start_row = 2
  11.    
  12.     '如果一直換頁 換到沒有筆數時 則停止(開始比數=結束比數 未增加)
  13.     Do Until (start_row = flag_row)
  14.    
  15.         start_row = Worksheets("BC Data").Range("C65536").End(xlUp).Row + 1
  16.         
  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))
  21.                 .WebSelectionType = xlSpecifiedTables
  22.                 .WebFormatting = xlWebFormattingNone
  23.                 .WebTables = "5"
  24.                 .WebPreFormattedTextToColumns = True
  25.                 .WebConsecutiveDelimitersAsOne = True
  26.                 .WebSingleBlockTextImport = False
  27.                 .WebDisableDateRecognition = False
  28.                 .WebDisableRedirections = False
  29.                 .Refresh BackgroundQuery:=False
  30.                 .Delete
  31.             End With
  32.    
  33.         '一頁面100筆 執行完換頁
  34.         page_no = page_no + 100
  35.         
  36.         '去標頭
  37.         Worksheets("BC Data").Rows(start_row).Delete
  38.         
  39.         '紀錄最末比
  40.         flag_row = Worksheets("BC Data").Range("C65536").End(xlUp).Row + 1
  41.         
  42.         '如果<100筆 執行一次結束即可
  43.         If Worksheets("BC Data").Range("C65536").End(xlUp).Row < 201 Then Exit Sub
  44.    
  45.     Loop
  46.    
  47. '    Debug.Print page_no
  48.    
  49. End Sub
複製代碼
P.S. 因為是公司內部網站,所以我以*****取代。
用功到世界末日那一天∼∼∼

TOP

回復 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))
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 4# GBKEE

感謝版大協助 !!!

所以我目前的程式碼

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

謝謝
用功到世界末日那一天∼∼∼

TOP

回復 5# li_hsien
因你這是內部網頁,看不到原始檔,所以不知如何改善.
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 6# GBKEE

感謝版大幫助

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

還是局部的原始碼

謝謝
用功到世界末日那一天∼∼∼

TOP

回復 7# li_hsien

未命名.JPG
2014-9-6 14:47


如網頁上有這總頁數,可抓取這總頁數來跑迴圈.
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 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>
複製代碼
煩請版大解惑

謝謝!!!
用功到世界末日那一天∼∼∼

TOP

回復 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 做該做的事是智慧,做不該做的事是愚癡。
返回列表 上一主題