Excel VBA質問箱 IV

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

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


11016 / 13644 ツリー ←次へ | 前へ→

【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 回答[未読]

【18619】動作が重すぎて
質問  かるかる  - 04/10/1(金) 16:28 -

引用なし
パスワード
   計測プログラムでキッチリ30秒ごとに計測させたいので
Td = Now + TimeValue("00:00:30")
For I = 1 To 50000
 
NS = I
Worksheets("Sheet1").Cells(I, 2).Activate
Worksheets("Sheet1").Cells(I, 1).Value = NS

Application.Wait (Td)
Td = Now + TimeValue("00:00:30")


というのを組んで動いたのですが、CPU負荷が100%、書き出すときだけ10%程度
余りに重過ぎて計測中何回か落ちて困りました。
長時間計測するので、一回一回のわずかな差でも最終的な実時間ではかなりの誤差に
なるので確実に30秒とりたいのですが、何か良いコマンドなりプログラムなりないでしょうか
ご教授願えると幸いです。

【18621】Re:動作が重すぎて
発言  ichinose  - 04/10/1(金) 18:20 -

引用なし
パスワード
   ▼かるかる さん:
こんばんは。

>計測プログラムでキッチリ30秒ごとに計測させたいので
以下のコードだと計測自体はキッチリという範疇で実行されているのですか?
ApplicationのOntimeメソッドを試してみてはどうでしょうか?


>Td = Now + TimeValue("00:00:30")
>For I = 1 To 50000
> 
> NS = I
> Worksheets("Sheet1").Cells(I, 2).Activate
> Worksheets("Sheet1").Cells(I, 1).Value = NS
>
> Application.Wait (Td)
> Td = Now + TimeValue("00:00:30")
>

【18622】Re:動作が重すぎて
発言  かるかる  - 04/10/1(金) 18:40 -

引用なし
パスワード
   ▼ichinose さん:
返答ありがとうございます

>以下のコードだと計測自体はキッチリという範疇で実行されているのですか?
申し訳ありません、書き方が悪かったです。
30秒ごとの測定は30.2秒や29.9秒など一秒以下の誤差なら構いません。
ですが30.2秒が積み重なって最終的に60000秒の計測が60145秒など最終的にずれると困るわけであります。

>ApplicationのOntimeメソッドを試してみてはどうでしょうか?
>
既に試してみましたが同様に負荷が非常に大きく使えませんでした。

【18626】Re:動作が重すぎて
発言  名無し  - 04/10/2(土) 0:52 -

引用なし
パスワード
   ▼かるかる さん:
>>ApplicationのOntimeメソッドを試してみてはどうでしょうか?
>>
>既に試してみましたが同様に負荷が非常に大きく使えませんでした。

ちなみにどんな感じのコードを書かれたんですか?

【18632】Re:動作が重すぎて
発言  ichinose  - 04/10/2(土) 2:35 -

引用なし
パスワード
   ▼名無し さん:
▼かるかる さん:
こんばんは。
私も確認してみました(実は、Ontimeを使用すれば、CPUの使用率のほうはOK
かと思っていたので)

まず、かるかるさんが投稿されたコードを調べました。
おっしゃられている通り、100%使用率で進行しています。


ONTimeメソッドを使用して同じ動作になるように作ってみました。

まず、標準モジュール(Module1)にスケジューリング関連のプロシジャー
'===============================================================
Private exetm As Variant '次の実行時刻
Private repcnt As Long '繰り返し回数
Private c_cnt As Long '現在の回数
Private reptm As Variant '実行間隔時間
Private prcnm As String '実行プロシジャー名
'========================================================================
Sub mc_schedule(ByVal on_off As Boolean, Optional ByVal rep_cnt As Long = 0, _
        Optional ByVal rep_time As Variant = 0, Optional ByVal proc_name As String = "")
'マクロ実行のスケジュールの設定を行う
'input : on_off --- true スケジュール設定 false---スケジュール解除
'    rep_cnt  実行を繰り返す回数
'    rep_time  実行間隔時間
'    proc_name 実行するプロシジャー名
  On Error Resume Next
  If on_off = True Then
    If rep_cnt > 0 Then
     reptm = rep_time
     repcnt = rep_cnt
     c_cnt = 0
     prcnm = proc_name
     End If
    exetm = Now() + reptm
    End If
  Application.OnTime EarliestTime:=exetm, Procedure:="mc_exec", Schedule:=on_off
  On Error GoTo 0
End Sub
'=====================================================================
Sub mc_exec()
'スケジュール設定されたプロシジャーを実行する
  Dim wk As Variant
  wk = Application.Run(prcnm)
  c_cnt = c_cnt + 1
  If c_cnt < repcnt Then
    Call mc_schedule(True)
    End If
End Sub

'次に別の標準モジュール(Module2)にかるかるさんの投稿されたコードに沿った
'コード
'======================================================================
Dim i As Long
'======================================================================
Sub main()
  i = 1
  test
  '設定
  Call mc_schedule(True, 49999, TimeValue("00:00:30"), "test")
'              ↑回数   ↑間隔時間     ↑実行するプロシジャー
end sub
'================================================================
Sub test()
  '実際にontimeメソッドで実行するプロシジャー
  ns = i
  Worksheets("Sheet1").Cells(i, 2).Activate
  Worksheets("Sheet1").Cells(i, 1).Value = ns
  i = i + 1
End Sub
'=================================================================
Sub subproc()
  '解除 途中終了のときのため
  Call mc_schedule(False)
End Sub


このコードのmainを実行してみて下さい。

これで、調べた結果、10%前後で推移している程度なんです。

時間誤差については、確認してみて下さい。

【18634】Re:動作が重すぎて
発言  名無し  - 04/10/2(土) 12:15 -

引用なし
パスワード
   ▼かるかる さん:
▼ichinose さん:
こんにちは。ichinoseさんのコードを参考に私もコードを書いてみました。
あまり自信がないですけど。変数名を少し変更しています。
後学のために、おかしな点がありましたら指摘してください。

'=== 変数・定数 ===
Private StopFlag As Boolean     '終了フラグ Trueで中断
Private Counter As Long       'カウンタ(元はI)
Private NextTime As Date       '次回実行時間(元はTd)
Const CountMax As Long = 50000    '処理回数
Const AddTime As String = "00:00:30" '間隔
Const ProcName As String = "Sec30"  'OnTimeで実行するプロシージャ名

'=== 開始 ===
Sub Proc_Start()
 If Counter > 0 Then Exit Sub '実行中は再実行させないで抜ける
 StopFlag = False       '終了フラグの初期化
 Counter = 1         'カウンタの初期化
 NextTime = Now() + TimeValue("00:00:02")
 Application.OnTime NextTime, ProcName
End Sub

'=== 中断する時はこれを実行 ===
Sub Proc_Stop()
 StopFlag = True
End Sub

'=== 処理部分 ===
Private Sub Sec30()
 Dim NS As Long
 NS = Counter 'このNSってなんでしょうか?
 
 Worksheets("Sheet1").Cells(Counter, 2).Activate
 Worksheets("Sheet1").Cells(Counter, 1).Value = NS '直接Counterじゃダメなんですか?

 Counter = Counter + 1
 
 'カウンタが処理回数を超えるか終了フラグがTrueなら終了
 If Counter > CountMax Or StopFlag Then
  Counter = 0
  MsgBox "終了!"
  Exit Sub
 End If
 NextTime = NextTime + TimeValue(AddTime) '前回実行時間に間隔時間を足す
 Application.OnTime NextTime, ProcName  'このプロシージャを指定時間後に再実行
End Sub

【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の使用率は未確認です。処理の中断は考慮してまへん。

試してみてな。
ほな。

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