Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


62691 / 76732 ←次へ | 前へ→

【18646】Re:動作が重すぎて
回答  bykin  - 04/10/3(日) 0:22 -

引用なし
パスワード
   おばんです。

OnTimeやったら、こんな感じでいけるとは思うねんけど・・・
(6秒ごとにイミディエイトに6回(最初の1回とループで5回)書き出す処理)

Sub TestOnTime()
  Const LOOP_COUNT = 5  'ループの回数
  Static i As Long
  
  Main i
  i = i + 1
  If i <= LOOP_COUNT Then
    Application.OnTime Now + TimeValue("00:00:06"), "TestOnTime"
  Else
    i = 0
  End If
End Sub

Sub Main(ByVal Counter As Long) 'メイン処理
  Debug.Print Counter, Timer
  DoEvents
End Sub

せやけど、ひょっとしたら

>30秒ごとの測定は30.2秒や29.9秒など一秒以下の誤差なら構いません。
>ですが30.2秒が積み重なって最終的に60000秒の計測が60145秒など
>最終的にずれると困るわけであります。

↑これがネックになるかも知れまへんなー
開始時刻を変数にキープしておいて、ループの中でチェックっていう
方法のほうが確実なんとちゃうかな?

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Declare Function GetTickCount Lib "kernel32" () As Long

Sub TestSleep()
  Const LOOP_COUNT = 5  'ループの回数
  Const INTERVAL = 6000  'メイン処理実行間隔(ミリ秒)
  Const EXEC_TIME = 1000 'メイン処理想定処理時間(ミリ秒)
  Dim StartTime As Long  'メイン処理開始時刻
  Dim NextTime As Long  '次のメイン処理実行時刻
  Dim i As Long
  
  StartTime = GetTickCount()
  Main i
  For i = 1 To LOOP_COUNT
    NextTime = INTERVAL * i
    Do
      If GetTickCount() - StartTime > NextTime Then Exit Do
      Sleep 10
    Loop
    Main i
    If i = LOOP_COUNT Then Exit For
    Sleep (INTERVAL - EXEC_TIME)
  Next
End Sub

Sub Main(ByVal Counter As Long) 'メイン処理
  Debug.Print Counter, Timer
  DoEvents
End Sub

60000秒(16時間以上)も待ってられへんから、どっちの誤差が大きいか
どうかはチェックできまへんが・・・
ま、短い時間やったらOnTimeでも問題ないみたいやね。
っていうか、両方とも16時間以上もちゃんと動き続けるかどうかは
保証できまへん(^^;;
本来はEXEを作るべきやろね。

※CPUの使用率は未確認です。処理の中断は考慮してまへん。

試してみてな。
ほな。

1 hits

【18619】動作が重すぎて かるかる 04/10/1(金) 16:28 質問
【18621】Re:動作が重すぎて ichinose 04/10/1(金) 18:20 発言
【18622】Re:動作が重すぎて かるかる 04/10/1(金) 18:40 発言
【18626】Re:動作が重すぎて 名無し 04/10/2(土) 0:52 発言
【18632】Re:動作が重すぎて ichinose 04/10/2(土) 2:35 発言
【18634】Re:動作が重すぎて 名無し 04/10/2(土) 12:15 発言
【18646】Re:動作が重すぎて bykin 04/10/3(日) 0:22 回答

62691 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free