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

標題: [發問] 請教此程序為何錯誤? [打印本頁]

作者: t8899 時間: 2015-4-4 20:14 標題: 請教此程序為何錯誤?

請教此程序為何錯誤?[attach]20574[/attach]

作者: bobomi 時間: 2015-4-4 21:21

Sub timestock()
' Application.EnableEvents = False
Application.ScreenUpdating = False
If TimeValue(The_Time) > TimeValue(Time) Then '預防上一次 OnTime尚未執行,再度執行一次OnTime
   Exit Sub
End If

' Time    '**** 執行的OnTime
' The_Time '**** 執行下一次OnTime

'------------------------------------------------------------------------------------------
Dim TIMEB, AG
TIMEB = 10
AG = (TimeValue(Now) * 60 * 60 * 24) - (Range("B2") * 60 * 60 * 24) '換為秒

  If AG > TIMEB Then
  On Error Resume Next
  Application.OnTime The_Time, "timestock", Schedule:=False
  If Err Then
   Application.OnTime The_Time, "timestock", Schedule:=True
  End If
   The_Time = 0
   Range("B2") = TimeValue(Now)
MsgBox "重跑"
timestock
Exit Sub
End If                                                 ' 333333
'--------------------------------------------------------------------------------

my = #12:00:01 AM#
The_Time = Time + my
Application.OnTime The_Time, "timestock"
[a2] = [a2] + 1
Range("a1").Value = Format(The_Time, "hh:mm:ss")

End Sub

作者: bobomi 時間: 2015-4-4 21:24

簡單的 code 複雜化

作者: bobomi 時間: 2015-4-4 21:41

本帖最後由 bobomi 於 2015-4-4 21:43 編輯

最簡單的方法就是 "通通" 不用指定 Schedule:=False  就不會有這個問題了
If AG > TIMEB Then
  Application.OnTime The_Time, "timestock"
   The_Time = 0
   Range("B2") = TimeValue(Now)
MsgBox "重跑"
timestock
Exit Sub
End If

作者: t8899 時間: 2015-4-4 22:30

最簡單的方法就是 "通通" 不用指定 Schedule:=False 就不會有這個問題了
If AG > TIMEB Then
Applicat ...
bobomi 發表於 2015-4-4 21:41

Schedule:=False 還是沒辦法終止?
之前在別的程序中也經常發生.......改成公用變數就可以停止,,這次就不行了
我的需求是跑一段時間後跳出再重跑，所以Schedule:=False 一定要確認退出才行

作者: bobomi 時間: 2015-4-4 23:10

本帖最後由 bobomi 於 2015-4-4 23:15 編輯

(1) 為何要跑一段時間後跳出呢
是因為你的 Sub timestock() 還沒計算完時, Sub timestock() 卻又莫名重新計算一次嗎 ?

(2)

my = #12:00:01 AM#
The_Time = Time + my
Application.OnTime The_Time, "timestock"

[a2] = [a2] + 1 ------------> 你這裡的真正原始 Code 是否是一段很耗時的計算, 會花蠻久的計算 ??????
Range("a1").Value = Format(The_Time, "hh:mm:ss")

作者: t8899 時間: 2015-4-5 06:22

本帖最後由 t8899 於 2015-4-5 06:23 編輯

(1) 為何要跑一段時間後跳出呢
是因為你的 Sub timestock() 還沒計算完時, Sub timestock() 卻又莫名重新 ...
bobomi 發表於 2015-4-4 23:10

上面是個測試
我是用ie連上某網站
Set Ie = CreateObject("InternetExplorer.Application")
Ie.Navigate "http://mis.twse.com.tw/stock/group.jsp?ex=tse&ind=TIDX#STATISTICS"
5秒網站會自動更新一次資料，我發現ie 停留10分會造成excel整個速度慢下來(滑鼠出現漏斗狀)，所以必須跳出IE, 再重跑

>>>>[a2] = [a2] + 1 ------------> 你這裡的真正原始 Code 是否是一段很耗時的計算, 會花蠻久的計算 ?????
我把這行拿掉也沒用

作者: bobomi 時間: 2015-4-5 07:29

Schedule:=False 還是沒辦法終止?
之前在別的程序中也經常發生.......改成公用變數就可以停止,,這次就不行了
t8899 發表於 2015-4-4 22:30

你的 Application.OnTime The_Time, "timestock", Schedule:=False 之所以會發出 Error Msg
是因為你的 Application.OnTime 早就已經自動被停止了
所以你再次對它下達停止的命令時, 它就會發出 Error Msg
因為 Application.OnTime 回呼進入執行 "timestock" 時 , EXCEL 就自動把它停止了

'=========
[a2] = [a2] + 1
Range("a1").Value = Format(The_Time, "hh:mm:ss")

my = #12:00:01 AM#
The_Time = Time + my
Application.OnTime The_Time, "timestock" ' ---> 把這個放到 sub timestock 的最後面來看看能不能解決

作者: bobomi 時間: 2015-4-5 08:10

5秒網站會自動更新一次資料，我發現ie 停留10分會造成excel整個速度慢下來(滑鼠出現漏斗狀)，所以必須跳出IE, 再重跑
t8899 發表於 2015-4-5 06:22

Ie.Navigate "http://mis.twse.com.tw/stock/group.jsp?ex=tse&ind=TIDX#STATISTICS"
讓 Ie.Navigate 只執行1次 ,  Ie.Navigate 不要出現在 sub timestock  , 而且保持 IE 永遠不被關閉

接下來用 Application.Otime  ....

Sub timestock()

Call Ie.Refresh2  '用 Ie.Refresh2  取代掉 Ie.Navigate
Do Until Ie.readyState = 4
DoEvents
Loop

my = #12:00:01 AM#
The_Time = Time + my
Application.OnTime The_Time, "timestock"

End  Sub

作者: t8899 時間: 2015-4-5 13:13

本帖最後由 t8899 於 2015-4-5 13:15 編輯

Ie.Navigate "http://mis.twse.com.tw/stock/group.jsp?ex=tse&ind=TIDX#STATISTICS"
讓 Ie.Naviga ...
bobomi 發表於 2015-4-5 08:10

Ie.Refresh2 這是ie 的屬性 ??後面多一個2 ???

你的 Application.OnTime The_Time, "timestock", Schedule:=False 之所以會發出 Error Msg
是因為你的 Application.OnTime 早就已經自動被停止了

它是執行到那一行被停止的??如何確認它已被停止了??
---------------------------------------------------
另外請教另一個問題附檔 [attach]20586[/attach]
此例 Schedule:=False 也是錯誤，不過要請教另一個問題
執行IE345678 後，大約17秒會重新跑(原本設計這是正常)，但執行中，為何切換到SHEET2時會連續一直出現"重跑"??
B2 的值當切換到SHEET2 就抓不到 ???(程序中有指定工作表)

作者: bobomi 時間: 2015-4-5 14:39

連續一直出現"重跑"??

If Time > [b2] + TIMEB Then
因為你的 [b2] 放在 module下, 而且沒有明確指定 [b2] 到底是 Sheet1.[b2] 還是 Sheet2.[b2], 還是 Sheet3.[b2].....
所以 EXCEL 自動幫你決定了
當你切換到SHEET1 時, EXCEL 自動把 [b2] 當成 Sheet1.[b2]
當你切換到SHEET2 時, EXCEL 自動把 [b2] 當成 Sheet2.[b2] (空值)

作者: t8899 時間: 2015-4-5 14:54

本帖最後由 t8899 於 2015-4-5 14:56 編輯

連續一直出現"重跑"??

If Time > + TIMEB Then
因為你的放在 module下, 而且沒有明確指定到底是 S ...
bobomi 發表於 2015-4-5 14:39

我有指明啊 !
它不是 private
With Workbooks("book1.xls").Sheets("sheet1")
.Range("B2") = TimeValue(Now)

作者: bobomi 時間: 2015-4-5 14:56

本帖最後由 bobomi 於 2015-4-5 15:01 編輯

[ 它是執行到那一行被停止的??如何確認它已被停止了?? ]

應該是要進入 Sub timestock() 之前,  Application.OnTime 就自動同時 Stop 了, 執行在內部所以你看不見

執行 Sub Test_01
步驟 (2) 能成功 , 步驟 (3) 卻失敗
就可以知道當  Application.OnTime Time + 1 / 86400, "AAA", , False '  執行失敗時(發出 Error Msg 時)
就代表著  Timer For Sub AAA 早已經停止了
因為步驟 (2) 已經成功停止了 Timer For Sub AAA
所以步驟 (3) 你再停止1次就失敗了 , 此時 Application.OnTime 內部早就沒有 Timer For Sub AAA 這條 Link , Application.OnTime 因為找不到 Timer For Sub AAA 而發出 Error Msg

Sub Test_01()
On Error GoTo 0: On Error Resume Next
Application.OnTime Time + 1 / 86400, "AAA", , True  '(1)--> 執行 ok
If Err Then MsgBox "err #1"
On Error GoTo 0: On Error Resume Next
Application.OnTime Time + 1 / 86400, "AAA", , False  '(2)--> 執行 ok (Timer For Sub AAA 已經停止)
If Err Then MsgBox "err #2"
On Error GoTo 0: On Error Resume Next
Application.OnTime Time + 1 / 86400, "AAA", , False '(3)--> 執行失敗
If Err Then MsgBox "err #3"
End Sub

作者: bobomi 時間: 2015-4-5 15:00

我有指明啊 !
它不是 private
With Workbooks("book1.xls").Sheets("sheet1")
.Range("B2") = TimeVal ...
t8899 發表於 2015-4-5 14:54

If Time > [b2] + TIMEB Then

你的 [b2] 前面沒有 . 啊

此時的 [b2] 變成 Sheet2.[b2] = 空值

[b2] 加上 . 就好了

作者: t8899 時間: 2015-4-5 18:02

本帖最後由 t8899 於 2015-4-5 18:23 編輯

If Time >  + TIMEB Then

你的  前面沒有 . 啊

此時的  變成 Sheet2. = 空值

加上 . 就好了 ...
bobomi 發表於 2015-4-5 15:00

我看了好幾次，還是沒有看到，謝謝!

作者: bobomi 時間: 2015-4-5 18:53

你可以用菜單的搜尋
搜尋 If Time > [b2] + TIMEB Then
就可以找到

作者: t8899 時間: 2015-4-5 19:03

本帖最後由 t8899 於 2015-4-5 19:04 編輯

你可以用菜單的搜尋
搜尋 If Time > + TIMEB Then
就可以找到
bobomi 發表於 2015-4-5 18:53

抱歉,經常看電腦螢幕，尤其在寫程式不知不覺一直注視.......加速眼睛老化..年紀也大了........所以看不到.........
現在找到了

作者: bobomi 時間: 2015-4-5 19:39

那個網址盤後測試是否一樣 ie 停留10分會造成excel整個速度慢下來
還是只有盤中才會 lag ?

作者: t8899 時間: 2015-4-5 20:15

那個網址盤後測試是否一樣 ie 停留10分會造成excel整個速度慢下來
還是只有盤中才會 lag ?
bobomi 發表於 2015-4-5 19:39

這網頁每5秒會自動update 一次，所以我連上一次然後開個副程式每隔5秒-60秒抓一次
每隔n秒抓一次，並不會造成lag, 是IE 連上後10分鐘才會lag, 從工作管理員看ie佔記憶體,時間越久記憶體佔越大
盤後我沒測試
這網頁不一定要借用IE來抓，應該還有其他方法像 XMLHTTP......... 不知您會嗎?可否賜教?

作者: bobomi 時間: 2015-4-5 20:39

以下是用 XMLHTTP 抓出來的內容
可以看到有欄位名稱, 但抓不到數值
那個網頁的數值是用 javascript 事後補上來的
你用 IE 開那個網頁-> IE菜單 -> 另存新檔 ---> 存到 xxx.htm ---> 再把 xxx.htm 用 IE 打開 ---> 只見欄位, 看不見數值

整體市場股票基金認購權證認售權證
總委買數量 - - - - -
總委買筆數 - - - - -
總委賣數量 - - - - -
總委賣筆數 - - - - -
漲停委買數量 - - - - -
漲停委買筆數 - - - - -
漲停委賣數量 - - - - -
漲停委賣筆數 - - - - -
跌停委買數量 - - - - -
跌停委買筆數 - - - - -
跌停委賣數量 - - - - -
跌停委賣筆數 - - - - -

作者: t8899 時間: 2015-4-5 21:20

本帖最後由 t8899 於 2015-4-5 21:25 編輯

以下是用 XMLHTTP 抓出來的內容
可以看到有欄位名稱, 但抓不到數值
那個網頁的數值是用 javascript 事後補 ...
bobomi 發表於 2015-4-5 20:39

這種5秒5秒一直更新，只有javascript 才做的到??
用IE 抓資料，速度太慢........太消眊資源...............再找看看有無其他法!
我目前是用GBKEE兄寫的,稍微做部份修改如下
Set Ie = CreateObject("InternetExplorer.Application")
Ie.Navigate "http://mis.twse.com.tw/stock/group.jsp?ex=tse&ind=TIDX#STATISTICS"
Dim timeie
timeie = DateAdd("s", 10, Now())
Do While Ie.Busy Or Ie.ReadyState <> 4
DoEvents
         If timeie < Now() Then
      MsgBoxTest 0, "無法連接網站,請重新執行", "提示訊息", vbSystemModal, 0, 2000
      Ie.Quit
         Exit Sub
         End If
         Loop
-----------------------------------------------------------------------------
Dim i As Integer, S As Integer, k As Integer, j As Integer
   Dim Element
Set Element = Ie.document.getelementsbytagname("table")
With Sheets("sheet5")
   '  .Range("C1:C17").ClearContents
      For S = 2 To 3                   '已找出網頁的table內容在 0-3 中
         For i = 0 To Element(S).Rows.Length - 1
            k = k + 1
            '  For j = 0 To Element(S).Rows(i).Cells.Length - 1 '資料的欄位共6位
            j = 2
                  .Cells(k, j + 1) = Element(S).Rows(i).Cells(j).innerText
         '    Next
         Next
      Next
End With
Set Element = Nothing

作者: bobomi 時間: 2015-4-6 09:49

流程控制好, 還是可以把效能影響降低的

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