12
返回列表 上一主題 發帖

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

power82843

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

論壇贊助勳章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2016-12-1 23:06 | 只看該作者

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

本帖最後由 power82843 於 2016-12-1 23:09 編輯

test.rar (476.9 KB) 各位先進小弟這個程式跑到一半就會卡住，可否幫我看看問題出在哪，感謝!
收藏 分享

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2016-12-2 07:18 | 只看該作者
本帖最後由 GBKEE 於 2016-12-2 07:19 編輯

回復 1# power82843

是這裡卡住嗎?
  1. Option Explicit
  2. Sub 股利股息()
  3.     Dim Sh As Worksheet, i As Integer
  4.     On Error Resume Next                  '不理會程式上的錯誤,程式繼續執行下去
  5.     Set Sh = Sheets("股利股息")        '沒有 Sheets("股利股息")時有程式上的錯誤]
  6.     On Error GoTo 0                           '程式停止處理錯誤,程式執行上有錯誤發生會終止.
  7.     If Sh Is Nothing Then                   '沒有 Sheets("股利股息")時 Sh Is Nothing
  8.         Sheets.Add after:=Sheets(Sheets.Count)
  9.         Sheets(Sheets.Count).Name = "股利股息"
  10.         Set Sh = Sheets("股利股息")
  11.     End If
  12.     With Sh ' Worksheets("股利股息").Select
  13.         .UsedRange.Clear
  14.         .Range("A1").Value = "++++++++++++++++++++++++++++++++++++++++++++++++++++"
  15.         .Range("B1").Value = "++++++++++++++++++++++++++++++++++++++++++++++++++++"
  16.         .Range("B2").Value = "++++++++++++++++++++++++++++++++++++++++++++++++++++"
  17.     End With
  18. For i = 10 To Sheets("個股資料").Range("B10").End(xlDown).Row
  19.      Sh.Cells(Rows.Count, 2).End(xlUp).Offset(1, -1).Resize(11) = Worksheets("個股資料").Range("C" & i).Value ' '將A欄位填入股票名稱，連續填寫11列
  20.     With Sh.QueryTables.Add(Connection:= _
  21.         "URL;https://tw.stock.yahoo.com/d/s/dividend_" & Sheets("個股資料").Range("B" & i) & ".html", Destination:=Sh.Cells(Rows.Count, 2).End(xlUp).Offset(1))
  22.         .Name = "0000000"
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

power82843

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

論壇贊助勳章
3#
發表於 2016-12-2 08:28 | 只看該作者
GBKEE 大大 抱歉沒有說清楚，是下面這一段程式，一開始可以跑得蠻順的，可是跑個80~200筆後就會卡住不跑，指標呈現等待的圖案。
  1. Sub ROE()

  3. For i = 10 To Sheets("個股資料").Range("B281").End(xlDown).Row
  4. Worksheets("ROE總表").Range("B1").Value = "++++++++++++++++++++++++++++++++++++++++++++++++++++"
  5. Worksheets("ROE").Select
  6.     With ActiveSheet.QueryTables.Add(Connection:= _
  7.         "URL;http://stockchannelnew.sinotrade.com.tw/z/zc/zcr/zcra/zcra_" & Sheets("個股資料").Range("B" & i) & ".djhtm", Destination:=Range("B1"))
  8.         .Name = "0000000"
  9.         .FieldNames = True
  10.         .RowNumbers = False
  11.         .FillAdjacentFormulas = False
  12.         .PreserveFormatting = True
  13.         .RefreshOnFileOpen = False
  14.         .BackgroundQuery = True
  15.         .RefreshStyle = xlInsertDeleteCells
  16.         .SavePassword = False
  17.         .SaveData = True
  18.         .AdjustColumnWidth = True
  19.         .RefreshPeriod = 0
  20.         .WebSelectionType = xlSpecifiedTables
  21.         .WebFormatting = xlWebFormattingNone
  22.         .WebTables = "1"
  23.         .WebPreFormattedTextToColumns = True
  24.         .WebConsecutiveDelimitersAsOne = True
  25.         .WebSingleBlockTextImport = False
  26.         .WebDisableDateRecognition = False
  27.         .WebDisableRedirections = False
  28.         .Refresh BackgroundQuery:=False
  29.     End With
  30.    
  31.     Range("C1:C500").Find("股東權益報酬率").Select
  32.     Range(Selection, Selection.End(xlToRight)).Copy
  33.     Worksheets("ROE總表").Select
  34.     Worksheets("ROE總表").Range("B1").Select
  35.     ActiveCell.End(xlDown).Select
  36.     lastrow = ActiveCell.Row
  37.     ActiveSheet.Paste Destination:=Worksheets("ROE總表").Range("b" & lastrow + 1)
  38.     Worksheets("ROE總表").Range("A" & lastrow + 1).Value = Worksheets("個股資料").Range("C" & i).Value
  39.     Worksheets("ROE").Select
  40.     Worksheets("ROE").Range("B1").Select
  41.     Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Delete

  43. Next

  45. End Sub
複製代碼

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
4#
發表於 2016-12-3 09:44 | 只看該作者
回復 3# power82843

卡在那裡?
  1. For i = 10 To Sheets("個股資料").Range("B281").End(xlDown).Row
  2.     Worksheets("ROE總表").Range("B1").Value = "++++++++++++++++++++++++++++++++++++++++++++++++++++"
  3.     Worksheets("ROE總表").Range("B2:J2") = Array("期別", "104", "103", "102", "101", "100", "99", "98", "97")
  4.     '是少了這裡嗎?   
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

准提部林

帖子
2834 
主題
10 
精華
0 
積分
2890 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-11-23 
5#
發表於 2016-12-3 11:23 | 只看該作者
本帖最後由 准提部林 於 2016-12-3 11:26 編輯
  1. Sub ROE_1()
  2. [ROE總表!B1].Value = String(52, "+")
  3. For i = 10 To [個股資料!B281].End(xlDown).Row
  4.     With Sheets("ROE").QueryTables.Add(Connection:= _
  5.         "URL;http://stockchannelnew.sinotrade.com.tw/z/zc/zcr/zcra/zcra_" & _
  6.         [個股資料!B1].Cells(i, 1) & ".djhtm", Destination:=[ROE!B1])
  7.         .Name = ""
  8.         .FieldNames = True
  9.         .RowNumbers = False
  10.         .FillAdjacentFormulas = False
  11.         .PreserveFormatting = True
  12.         .RefreshOnFileOpen = False
  13.         .BackgroundQuery = True
  14.         .RefreshStyle = xlInsertDeleteCells
  15.         .SavePassword = False
  16.         .SaveData = True
  17.         .AdjustColumnWidth = True
  18.         .RefreshPeriod = 0
  19.         .WebSelectionType = xlSpecifiedTables
  20.         .WebFormatting = xlWebFormattingNone
  21.         .WebTables = "1"
  22.         .WebPreFormattedTextToColumns = True
  23.         .WebConsecutiveDelimitersAsOne = True
  24.         .WebSingleBlockTextImport = False
  25.         .WebDisableDateRecognition = False
  26.         .WebDisableRedirections = False
  27.         .Refresh BackgroundQuery:=False
  28.         .Delete
  29.     End With
  30.    
  31.     Dim xF As Range, xE As Range
  32.     Set xF = [ROE!C1:C500].Find("股東權益報酬率")
  33.     If Not xF Is Nothing Then
  34.        Set xE = [ROE總表!B1].End(xlDown)(2)
  35.        xE.Select
  36.        Range(xF, xF.End(xlToRight)).Copy xE
  37.        xE(1, 0) = Sheets("個股資料").Range("C" & i)
  38.     End If
  39.     Sheets("ROE").UsedRange.Clear
  40. Next
  41. End Sub
複製代碼

TOP

power82843

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

論壇贊助勳章
6#
發表於 2016-12-3 12:16 | 只看該作者
GBKEE 您好!
就像下方畫面，跑了100多筆之後就一直卡在這個畫面。

TOP

power82843

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

論壇贊助勳章
7#
發表於 2016-12-3 12:18 | 只看該作者
回復 5# 准提部林

准提部林 大大
您的程式跑起來快很多，但是還是會卡住，如下畫面，可以再幫忙看是什麼問題嗎?感謝!

TOP

power82843

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

論壇贊助勳章
8#
發表於 2016-12-3 12:19 | 只看該作者
回復 4# GBKEE

GBKEE 您好!
就像下方畫面，跑了100多筆之後就一直卡在這個畫面。

TOP

jackyq

帖子
319 
主題
6 
精華
0 
積分
309 
點名
0  
作業系統
xp 
軟體版本
2k 
閱讀權限
20 
性別
男 
註冊時間
2015-6-24 
最後登錄
2024-4-27 
9#
發表於 2016-12-3 13:28 | 只看該作者
your  ip is locked ..........

TOP

准提部林

帖子
2834 
主題
10 
精華
0 
積分
2890 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-11-23 
10#
發表於 2016-12-3 14:09 | 只看該作者
回復 7# power82843


有無跳出錯誤視窗, 及錯誤行的位置,
大部份網頁為防止短時間多次的存取, 會鎖住您的ip, 所以無法完成全部匯入!

TOP

        靜思自在 : 生氣，就是拿別人的過錯來懲罰自己。
12
返回列表 上一主題