返回列表 上一主題 發帖

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

回復 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

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

TOP

回復 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

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

TOP

回復 7# blue2263
其實道理是一樣的。
你也可加入 #9 增加的部份。

TOP

        靜思自在 : 我們最大的敵人不是別人.可能是自己。
返回列表 上一主題