跑到一半會卡住~~ - Excel程式區 - 麻辣家族討論版版

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

11^# 跳轉到 »

發表於 2016-12-3 16:56 | 只看該作者

本帖最後由 GBKEE 於 2016-12-3 17:02 編輯

回復 8# power82843
3708 上緯投控沒有資料

Range("C1:C500").Find("股東權益報酬率").Select

複製代碼

卡在這裡是嗎?
試試看

Option Explicit
Sub Ex_ROE()
Dim Sh(1 To 3) As Worksheet, Rng As Range, i As Integer
Set Sh(1) = Sheets("個股資料")
Set Sh(2) = Worksheets("ROE總表")
Set Sh(3) = Worksheets("ROE")
'***執行本程式碼一次後,可刪除掉兩行星號間的程式碼**
'*************************************
'刪除 ROE 頁上QueryTables及 QueryTables.Add所新增的名稱
'QueryTable過多,名稱過多也是檔案膨大的原因之ㄧ
With Sh(3)
For i = .Names.Count To 1 Step -1
.Names(i).Delete
Next
.UsedRange.Clear
For i = .QueryTables.Count To 1 Step -1
.QueryTables(i).Delete
Next
End With
'******************************
With Sh(2)
.UsedRange.Clear
.Range("B1") = "++++++++++++++++++++++++++++++++++++++++++++++++++++"
.Range("B2:J2") = Array("期別", "104", "103", "102", "101", "100", "99", "98", "97")
.Activate
End With
For i = 10 To Sh(1).Range("B281").End(xlDown).Row
If Sh(1).Range("B" & i) <> "" Then '非空白儲存格
With Sh(3).QueryTables.Add(Connection:= _
"URL;http://stockchannelnew.sinotrade.com.tw/z/zc/zcr/zcra/zcra_" & Sh(1).Range("B" & i) & ".djhtm", Destination:=Sh(3).Range("B1"))
'.Name = "0000000" '名稱以數字開頭,會自動加上"_" 為 "_0000000"
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "1"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
With Sh(3).QueryTables(1)
Application.StatusBar = i - 9 & " - " & .ResultRange.Range("b2") & " 股東權益報酬率完成"
If .ResultRange.Rows.Count > 5 Then
Sh(2).Range("b1").End(xlDown).Offset(1, -1).Resize(, .ResultRange.Columns.Count) = .ResultRange.Rows(16).Value
Sh(2).Range("b1").End(xlDown).Offset(, -1) = Sh(1).Range("C" & i)
Sh(2).Range("b1").End(xlDown).Offset(, -1).Activate
Else
Sh(2).Range("b1").End(xlDown).Offset(1) = "查無 " & .ResultRange.Range("b2") & " 財務比率表資料(合併年表)"
End If
.ResultRange.Clear '清除匯入外部的資料
Sh(3).Names(.Name).Delete '刪除自動新增的名稱
.Delete '刪除 QueryTable 物件
End With
End If
Next
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2808
主題: 10
精華: 0
積分: 2864
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-5-28

12^#

發表於 2016-12-3 18:39 | 只看該作者

執行了三次, 都可以順利跑完:

Xl0000003.rar (288.27 KB)

TOP

jackyq

中學生 Rank: 2

帖子: 319
主題: 6
精華: 0
積分: 309
點名: 0
作業系統: xp
軟體版本: 2k
閱讀權限: 20
性別: 男
註冊時間: 2015-6-24
最後登錄: 2024-4-27

13^#

發表於 2016-12-3 18:45 | 只看該作者

本帖最後由 jackyq 於 2016-12-3 18:55 編輯

發現是 QueryTables 積累太多的關係
加上這個就好了

For Each QQ In Worksheets("ROE").QueryTables
QQ.Delete
Next

我看准提部林已經幫你加上 delete
結果還會卡
才會以為是不是被鎖IP
結果加上 delay 後就可以跑完
才會以為真的被鎖 IP

結論: 不砍 QueryTables 用 delay 後就可以跑, 當然比較慢

TOP

power82843

小學生 Rank: 1

帖子: 7
主題: 2
精華: 0
積分: 12
點名: 0
作業系統: WIN7
軟體版本: WIN7
閱讀權限: 10
註冊時間: 2016-9-28
最後登錄: 2017-3-5

論壇贊助勳章

14^#

發表於 2016-12-3 19:36 | 只看該作者

回復 10# 准提部林
請問遇到這樣的情況要如何避免?

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2808
主題: 10
精華: 0
積分: 2864
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-5-28

15^#

發表於 2016-12-3 21:34 | 只看該作者

回復 14# power82843

被鎖住ip, 應會出現錯誤視窗, 而且也應無法再執行, 除非清除所有的瀏覽歷程及cookie(依以前抓奇摩知識+經驗),
如果是沒有跑完到工作表的最後一筆資料, 應是 End(xlDown)的問題, 遇到空白格就停頓, 改用End(xlUp)即可,
以目前的資枓, End(xlDown) , 第368列[2301 光寶科]就是最後一筆!

For i = 10 To [個股資料!B1].Cells(Rows.Count, 1).End(xlUp).Row
則可以跑到第890列!!!

TOP

[發問] 跑到一半會卡住~~

[收藏此主題] [關注此主題的新回復]

[通過 QQ、MSN 分享給朋友]