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

標題: [發問] 處理一定時間中斷執行 [打印本頁]

作者: li_hsien 時間: 2014-9-1 11:45 標題: 處理一定時間中斷執行

最近在用QueryTable 連網站抓資料

因為有使用到迴圈來處理

所以執行上有點緩慢

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

請問各位大大

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

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

不知能否這樣處理

謝謝

作者: GBKEE 時間: 2014-9-1 14:32

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

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

作者: li_hsien 時間: 2014-9-1 17:57

回復 2# GBKEE

下方的page_no是用來換頁

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

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

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

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

Sub Search_Click()
Dim Key_URL As String
Dim start_row As Integer
Dim flag_row As Integer
Dim page_no As Integer
'多頁切換
page_no = 0
'起始欄位
start_row = 2
'如果一直換頁換到沒有筆數時則停止(開始比數=結束比數未增加)
Do Until (start_row = flag_row)
start_row = Worksheets("BC Data").Range("C65536").End(xlUp).Row + 1
Key_URL= "URL;http:// ***** & "pageoffset=" & page_no
With Worksheets("BC Data").QueryTables.Add(Connection:=Key_URL, _
Destination:=Worksheets("BC Data").Range("A" & start_row))
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "5"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
.Delete
End With
'一頁面100筆執行完換頁
page_no = page_no + 100
'去標頭
Worksheets("BC Data").Rows(start_row).Delete
'紀錄最末比
flag_row = Worksheets("BC Data").Range("C65536").End(xlUp).Row + 1
'如果<100筆執行一次結束即可
If Worksheets("BC Data").Range("C65536").End(xlUp).Row < 201 Then Exit Sub
Loop
' Debug.Print page_no
End Sub

複製代碼

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

作者: GBKEE 時間: 2014-9-2 14:14

回復 3# li_hsien
試試看

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

複製代碼

作者: li_hsien 時間: 2014-9-2 15:08

回復 4# GBKEE

感謝版大協助 !!!

所以我目前的程式碼

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

謝謝

作者: GBKEE 時間: 2014-9-3 16:14

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

作者: li_hsien 時間: 2014-9-3 16:24

回復 6# GBKEE

感謝版大幫助

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

還是局部的原始碼

謝謝

作者: GBKEE 時間: 2014-9-6 14:51

回復 7# li_hsien

[attach]19105[/attach]

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

作者: li_hsien 時間: 2014-9-9 22:33

回復 8# GBKEE

請教一下版大

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

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

<SCRIPT LANGUAGE="JavaScript1.1">
<!--
function goToPage(s) {
var thisForm = window.document.forms[0];
var page_n = 11;
var page_range = 100;
var box_name = "go_to_page" + s;
var search_link = **********;
for (var i=0; i < thisForm.elements.length; i++) {
var nextElement = thisForm.elements[i];
if (nextElement.name == box_name) {
go_to_page = nextElement.value;
}
}
if (go_to_page == null || go_to_page == 0) {
alert("您必須輸入 1 到 11 之間的其中一個頁碼。");
}
else if (1 <= go_to_page && go_to_page <= page_n) {
var offset = (go_to_page - 1) * page_range
location.href = search_link + offset;
}
else {
alert("您必須輸入 1 到 11 之間的其中一個頁碼。");
}
}
//end hiding -->
</SCRIPT>
 <P><B>
第 1 頁，共 11 頁<A HREF=**********>>></A>

複製代碼

煩請版大解惑

謝謝!!!

作者: GBKEE 時間: 2014-9-10 14:18

回復 9# li_hsien

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

複製代碼

作者: li_hsien 時間: 2014-9-11 11:06

回復 10# GBKEE

對於網站資料的操作好陌生

感謝版大淺顯易懂的說明

版大的作法應該是
先用getElementsByTagName找網頁的標簽名稱
(不過看版大的寫法是不區分大小寫嗎?)

再抓取夾在標簽裡面的文字(innertext)敘述吧???

謝謝版大!!!

作者: GBKEE 時間: 2014-9-11 12:59

getElementsByTagName找網頁的標簽名稱
(不過看版大的寫法是不區分大小寫嗎?)
li_hsien 發表於 2014/9/11 11:06

是的:不區分大小寫的

作者: li_hsien 時間: 2014-9-15 11:54

回復 4# GBKEE

請問版大

我後來發現

網址中有個sessionid

會變動= =

變成常常抓不到資料

請問這部分有辦法克服嗎???

感謝!!!

作者: GBKEE 時間: 2014-9-15 17:16

回復 13# li_hsien

[attach]19153[/attach]

如圖搜索一下,可了解如何在Excel抓取網頁資料

作者: li_hsien 時間: 2014-9-15 18:57

回復 14# GBKEE

版大能否提供文章連結?

我竟然只能搜尋標題@@

不能搜尋全文

謝謝

作者: GBKEE 時間: 2014-9-16 15:58

回復 15# li_hsien

http://forum.twbts.com/viewthread.php?tid=12029
http://forum.twbts.com/viewthread.php?tid=12322
http://forum.twbts.com/viewthread.php?tid=12044

作者: li_hsien 時間: 2014-9-16 18:41

回復 16# GBKEE

感謝版大協助提供

我再來研究看看

TKS~

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