12
返回列表 上一主題 發帖

[發問] 程式流程控制問題

blue2263

帖子
150 
主題
40 
精華
0 
積分
215 
點名
0  
作業系統
windows xp 
軟體版本
sp3 
閱讀權限
20 
註冊時間
2013-7-15 
最後登錄
2024-10-2 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2016-10-6 07:55 | 只看該作者

[發問] 程式流程控制問題

我的問題如下圖,請教大大程式碼要如何更改?

麻煩大大幫忙解答,感恩謝謝!!
測試.rar (219.81 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-10-6 09:09 | 只看該作者
回復 1# blue2263

請修正


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

TOP

blue2263

帖子
150 
主題
40 
精華
0 
積分
215 
點名
0  
作業系統
windows xp 
軟體版本
sp3 
閱讀權限
20 
註冊時間
2013-7-15 
最後登錄
2024-10-2 
3#
發表於 2016-10-6 20:32 | 只看該作者
G大您好
不好意思,測試修正時改到一些內容,己更改好了
測試修正2.rar (222.58 KB)

TOP

blue2263

帖子
150 
主題
40 
精華
0 
積分
215 
點名
0  
作業系統
windows xp 
軟體版本
sp3 
閱讀權限
20 
註冊時間
2013-7-15 
最後登錄
2024-10-2 
4#
發表於 2016-10-8 07:16 | 只看該作者
本帖最後由 blue2263 於 2016-10-8 07:26 編輯

回復 2# GBKEE
G大您好
不好意思,不會跳回主程式,的問題還是存在?

之前測試時,更改了程式內容,忘記改回來,請以測試修正2查看,謝謝
測試修正2.rar (222.58 KB)

還請G大幫忙解答,感恩謝謝!!!

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
5#
發表於 2016-10-8 08:23 | 只看該作者
回復 4# blue2263
試試看
  1. Sub 開始執行()
  2.     Dim startOn As Boolean
  3.    
  4.     Set MyBook = ThisWorkbook
  5.     aTime = "08:44:00"  '  早  盤 開盤時間   "08:44:00"
  6.     bTime = "13:45:05"  '  早  盤 收盤時間   "13:45:00"
  7.     cTime = "14:35:00"  '  電子盤 開盤時間   "14:35:00"
  8.     dTime = "23:59:50"  '  電子盤 換日時間   "00:00:00"
  9.     eTime = "03:00:05"  '  電子盤 收盤時間   "03:00:00"
  10.     startOn = False
  11.         
  12.     '  等候至早上開盤 , 自動執行主程式
  13.     If Time > TimeValue("03:00:00") And Time < TimeValue("13:45:00") Then
  14.         startOn = True
  15.         Set Sht1 = MyBook.Sheets("a")
  16.         aaTime = bTime  '  停止記錄時間 "13:45:00"
  17.         If Time < TimeValue("08:44:00") Then
  18.             Application.StatusBar = "※現在尚未開盤，程式等待至8:45開盤自動執行"
  19.             Application.OnTime TimeValue("08:44:05"), "開始"
  20.             Application.OnTime TimeValue("08:44:10"), "自動記錄"
  21.         Else
  22.             Call 開始
  23.             Call 自動記錄
  24.         End If
  25.     End If
  26.    
  27.     '  等候至中午電子盤 , 開盤自動執行主程式
  28.     If Time > TimeValue("13:45:00") And Time < TimeValue("23:59:59") Then
  29.         startOn = True
  30.         Set Sht1 = MyBook.Sheets("b")
  31.         aaTime = dTime  '  停止記錄時間 "00:00:00"
  32.         If Time < TimeValue("14:34:00") Then
  33.             Application.StatusBar = "※現在尚未開盤，程式等待至14:35:00開盤自動執行"
  34.             Application.OnTime TimeValue("14:34:05"), "開始"
  35.             Application.OnTime TimeValue("14:34:10"), "自動記錄"
  36.         Else
  37.             Call 開始
  38.             Call 自動記錄
  39.         End If
  40.     End If
  41.    
  42.     '  等候至中午電子盤(換日) , 開盤自動執行主程式
  43.     If Time > TimeValue("00:00:01") And Time < TimeValue("03:00:00") Then
  44.         startOn = True
  45.         Set Sht1 = MyBook.Sheets("b")
  46.         aaTime = eTime  '  停止記錄時間 "03:00:05"
  47.         If Time < TimeValue("00:00:30") Then
  48.             Application.OnTime TimeValue("00:00:30"), "開始"
  49.             Application.OnTime TimeValue("00:00:35"), "自動記錄"
  50.         Else
  51.             Call 開始
  52.             Call 自動記錄
  53.         End If
  54.     End If
  55.    
  56.     If startOn Then Application.OnTime Now + TimeValue("00:00:01"), "開始執行"   '  每一秒遞迴一次
  57. End Sub

  59. Sub 自動記錄()
  60.     If uMode = 0 Then Exit Sub
  61.     If Time > TimeValue(aaTime) Then '  收盤時間以後不執行
  62.        Application.DisplayStatusBar = True  '  打開狀態列。
  63.        Application.StatusBar = "收盤"
  64.        ActiveWorkbook.Save '  當前工作表儲存
  65.        Exit Sub
  66.     End If
  67.     '  每分鐘記錄----------------------------------------------------------
  68.     If Second(Time) = 0 Then
  69.         xRow = Sht1.Range("A8").End(xlDown).Row  '  由上往下找
  70.         Sht1.Range("B1") = xRow + 1
  71.         Sht1.Range("A10").EntireRow.Insert
  72.         Sht1.Range("A10:CZ10").Value = Sht1.Range("A9:CZ9").Value
  73.         Sht1.Range("b10") = Time
  74.     End If
  75. End Sub
複製代碼

TOP

blue2263

帖子
150 
主題
40 
精華
0 
積分
215 
點名
0  
作業系統
windows xp 
軟體版本
sp3 
閱讀權限
20 
註冊時間
2013-7-15 
最後登錄
2024-10-2 
6#
發表於 2016-10-8 13:19 | 只看該作者
回復 5# c_c_lai

測試是可以順利進行,上下午盤的每分記錄
不過巨集更改後,有幾個延伸的小問題,想請教
1.巨集更改後,畫面會不停閃爍
2.程式執行後,如想停止執行,會無法停止

感謝C大幫忙,謝謝

TOP

blue2263

帖子
150 
主題
40 
精華
0 
積分
215 
點名
0  
作業系統
windows xp 
軟體版本
sp3 
閱讀權限
20 
註冊時間
2013-7-15 
最後登錄
2024-10-2 
7#
發表於 2016-10-8 14:36 | 只看該作者
本帖最後由 blue2263 於 2016-10-8 14:41 編輯

回復 5# c_c_lai
  1. Sub 自動記錄()
  2.    
  3.         If uMode = 0 Then Exit Sub
  4.         If Time > TimeValue(aaTime) Then  '收盤時間以後不執行
  5.            Application.DisplayStatusBar = True  '打開狀態列。
  6.            Application.StatusBar = "收盤"
  7.            'ActiveWorkbook.Save '當前工作表儲存
  8.            Application.Wait (Now + TimeValue("0:00:10"))  '等待x秒後進行
  9.            Call 開始執行
  10.            Exit Sub
  11.         End If
  12.         '每分鐘記錄----------------------------------------------------------
  13.         If Second(Time) = 0 Then
  14.             xRow = Sht1.Range("A8").End(xlDown).Row  '由上往下找
  15.             Sht1.Range("B1") = xRow + 1
  16.             Sht1.Range("A10").EntireRow.Insert
  17.             Sht1.Range("A10:CZ10").Value = Sht1.Range("A9:CZ9").Value
  18.             Sht1.Range("b10") = Time
  19.         End If
  20.         
  21.         Application.OnTime Now + TimeValue("00:00:01"), "自動記錄"   '每一秒遞迴一次

  23. End Sub
複製代碼
C大您好
我增加第9列程式碼,跳回主程式便可正常執行
感謝C大熱心幫忙,謝謝!!

TOP

GBKEE

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

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

回復 7# blue2263
試試看
  1. Option Explicit
  2. Public uMode&, xTime(1 To 5)
  3. Public MyBook As Workbook, Sht1 As Worksheet, Sht2 As Worksheet, xRow&, 更新判斷
  4. Sub 開始執行()
  5.         Set MyBook = ThisWorkbook
  6.         xTime(1) = #3:00:00 AM# '電子盤 收盤時間 "03:00:00"
  7.         xTime(2) = #8:44:00 AM# '早盤 開盤時間 "08:44:00"
  8.         xTime(3) = #1:45:00 PM# '早盤 收盤時間 "13:45:00"
  9.         xTime(4) = #2:35:00 PM# '電子盤 開盤時間 "14:35:00"
  10.         If Time <= #11:59:59 AM# Then
  11.             Set Sht1 = MyBook.Sheets("a") '早盤
  12.             If Time <= xTime(1) Or Time >= xTime(2) Then
  13.                  If Time <= xTime(1) Then Set Sht1 = MyBook.Sheets("b")                     '電子盤
  14.                 設定
  15.                 自動記錄
  16.             Else         '早盤
  17.                 xTime(5) = xTime(2) - #12:00:05 AM#
  18.                 Application.OnTime xTime(5), "設定"
  19.                 xTime(5) = xTime(2) + #12:00:10 AM#
  20.                 Application.OnTime xTime(5), "自動記錄"
  21.             End If
  22.         Else
  23.             Set Sht1 = MyBook.Sheets("B")  '電子盤
  24.             If Time <= xTime(3) Or Time >= xTime(4) Then
  25.                 If Time <= xTime(3) Then Set Sht1 = MyBook.Sheets("a") '早盤
  26.                 設定
  27.                 自動記錄
  28.             Else
  29.                 xTime(5) = xTime(4) - #12:00:05 AM#
  30.                 Application.OnTime xTime(5), "設定"
  31.                 xTime(5) = xTime(4) + #12:00:10 AM#
  32.                 Application.OnTime xTime(5), "自動記錄"
  33.             End If
  34.         End If
  35. End Sub
  36. Sub 自動記錄()
  37.         Dim Msg As Boolean
  38.        If uMode = 0 Then Exit Sub
  39.         If Time <= #11:59:59 AM# Then
  40.             If Time > xTime(1) And Time < xTime(2) Then
  41.                 Msg = True
  42.                 xTime(5) = xTime(2) - #12:00:05 AM#
  43.                 Application.OnTime xTime(5), "設定"
  44.                 xTime(5) = xTime(2) + #12:00:10 AM#
  45.                 Application.OnTime xTime(5), "自動記錄"
  46.                 Application.StatusBar = "早盤 開盤時間" & xTime(5)
  47.             End If
  48.         Else
  49.             If Time > xTime(3) And Time < xTime(4) Then
  50.                 Msg = True
  51.                 xTime(5) = xTime(2) - #12:00:05 AM#
  52.                 Application.OnTime xTime(5), "設定"
  53.                 xTime(5) = xTime(2) + #12:00:10 AM#
  54.                 Application.OnTime xTime(5), "自動記錄"
  55.                 Application.StatusBar = "電子盤 開盤時間" & xTime(5)
  56.             End If
  57.         End If
  58.         If Msg Then
  59.            Application.DisplayStatusBar = True  '打開狀態列。
  60.            'Application.StatusBar = "收盤"
  61.            ActiveWorkbook.Save '當前工作表儲存
  62.            Exit Sub
  63.          End If
  64.         '每分鐘記錄----------------------------------------------------------
  65.    '     If Second(Time) = 0 Then
  66.             xRow = Sht1.Range("A8").End(xlDown).Row  '由上往下找
  67.             Sht1.Range("B1") = xRow + 1
  68.             Sht1.Range("A10").EntireRow.Insert
  69.             Sht1.Range("A10:CZ10").Value = Sht1.Range("A9:CZ9").Value
  70.             Sht1.Range("b10") = Time
  71.    '     End If
  72.         '********每分鐘記錄- 畫面不會不停閃爍了****************
  73.         xTime(5) = TimeSerial(Hour(Time), Minute(Time) + 1, 0)
  74.         Application.OnTime xTime(5), "自動記錄" '每分遞迴一次
  75. End Sub
  76. Sub 設定()
  77.         uMode = 1
  78.         Sht1.Select
  79.         Sht1.Range("a9") = Date '日期
  80.         Application.DisplayStatusBar = False  '關閉狀態列。
  81. End Sub
  82. Sub 開始()
  83.     開始執行
  84. End Sub
  85. Sub 停止執行()
  86.     uMode = 0
  87.     Application.DisplayStatusBar = True  '打開狀態列。
  88.     Application.StatusBar = "己停止執行"
  89.     If Not IsEmpty(xTime(5)) And Time < xTime(5) Then
  90.         Application.OnTime xTime(5), "自動記錄", Schedule:=False  '停止未執行的 OnTime排程
  91.     End If
  92. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
9#
發表於 2016-10-8 15:22 | 只看該作者
回復 6# blue2263
你原本的程式碼便會有此問題，差別是當你第一次執行
自動記錄() 一直到 If Time > TimeValue(aaTime) Then
料離後便停止不再執行了。 (只 RUN 第一迴輪而已)。
所以在每一秒的視覺上(畫面會不停閃爍)自然會有所不同。
修正後的程式才是正常運作的過程。(三種判斷皆過濾)
當然她會一直執行到條件滿足為止。
如果你想令它能中途停止，則需加入插斷判斷。
修改 (公用變數增加 stp )
  1. Public uMode&, aTime, bTime, cTime, dTime, eTime, aaTime, bbTime, stp As Boolean
  2. Public MyBook As Workbook, Sht1 As Worksheet, Sht2 As Worksheet, xRow&, 更新判斷, xTime

  4. Sub 開始執行()
  5.     Dim startOn As Boolean
  6.    
  7.     If stp Then stp = False: Exit Sub    '  插斷
  8.     Set MyBook = ThisWorkbook
複製代碼
增加
  1. Sub 插斷()
  2.     stp = True
  3. End Sub
複製代碼
工作表上增加一 "按鈕"  指定巨集指向  "插斷()" 即可，
點選它便停止執行；接這再次點選它，便又繼續執行了。

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
10#
發表於 2016-10-8 15:35 | 只看該作者
回復 7# blue2263
其實道理是一樣的。
你也可加入 #9 增加的部份。

TOP

        靜思自在 : 待人退一步，愛人寬一寸，就會活得很快樂。
12
返回列表 上一主題