ＶＢＡ 5分間間隔でデータ記録

こんにちわ。
いつも諸先輩方に教えて頂きありがとうございます。
感謝しております。

早速ですが以下のようなＶＢを教えてもらいまして、
Ｃ３のセルにリアルタイムで変化する数字があります。

それを、３秒おきに時間とともにＣ６から順に記録して
１分間溜まったら、
Ｅ６に時間、
Ｆ６その１分間の最初の値、
Ｇ６にその１分間での最高値
Ｈ６にその１分間での最低値
I６にその１分間での最後の値
が順番に記録されるようになっております。　　　

このマクロを改正して、
　(1)１秒感覚でＣ３から下へ順に記録。
　(2)５分間隔でＥ６＾Ｉ６に４種の値を下へ順に記録
　　（このデータはずっと起動している間は下へ記録し続けたいです）
　
というように変更したいのですがうまくいかず、四苦八苦しておりました。
お忙しいところ申し訳ありませんが、
ヒントなるものでも結構ですので教えて頂ければ幸いです。
以上宜しくお願いいたします。
　　　　　　UNO

　　　

=========================================================
Option Explicit
Public STOP_B As Boolean

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub ストップ()
STOP_B = False
End Sub

Sub スタート()
Dim i As Integer
Dim t As Integer
Dim n As Integer
Dim R As Range
Dim timenow As Variant
i = 6
n = 6
STOP_B = True
Do While True
t = 0
timenow = Format(Now(), "HH:mm")

While t < 300
Call Sleep(10)
DoEvents
t = t + 1
Wend
If timenow = Format(Now(), "HH:mm") Then

Sheet1.Cells(i, 3).Value = Sheet1.Range("C3").Value
i = i + 1
Else
Sheet1.Cells(n, 5).Value = timenow
Sheet1.Cells(n, 6).Value = Sheet1.Cells(6, 3).Value
Set R = Sheet1.Range(Sheet1.Cells(6, 3), Sheet1.Cells(i, 3))
Sheet1.Cells(n, 7).Value = WorksheetFunction.Max(R)
Sheet1.Cells(n, 8).Value = WorksheetFunction.Min(R)
Sheet1.Cells(n, 9).Value = Sheet1.Cells(i - 1, 3).Value

Sheet1.Range(Sheet1.Cells(6, 3), Sheet1.Cells(i, 3)).Clear

i = 6
Sheet1.Cells(i, 3).Value = Sheet1.Range("C3").Value
i = i + 1
n = n + 1
End If
If STOP_B = False Then

Exit Sub
End If
Loop
End Sub

Function xSleep(ByVal dwMilliseconds As Long)
Call Sleep(dwMilliseconds)
End Function

=====================================================

No.1 ベストアンサー 回答者： Wizard_Zero 回答日時： 2009/08/18 23:51

Sub スタート()

Dim i As Integer
Dim t As Integer
Dim n As Integer
Dim R As Range
'Dim timenow As Variant
Dim timenow As Date

i = 6
n = 6
STOP_B = True

' 5分後の時刻を算出
timenow = DateAdd("n", 5, Now())

Do While True
t = 0
'timenow = Format(Now(), "HH:mm")

' １秒間ウェイト
While t < 10
Call Sleep(100)
DoEvents
t = t + 1
Wend


'If timenow = Format(Now(), "HH:mm") Then

' 5分後の時刻に達していない場合
If DateDiff("s", timenow, Now) < 0 Then

Sheet1.Cells(i, 3).Value = Sheet1.Range("C3").Value
i = i + 1

Else
Sheet1.Cells(n, 5).Value = timenow
Sheet1.Cells(n, 6).Value = Sheet1.Cells(6, 3).Value
Set R = Sheet1.Range(Sheet1.Cells(6, 3), Sheet1.Cells(i, 3))
Sheet1.Cells(n, 7).Value = WorksheetFunction.Max(R)
Sheet1.Cells(n, 8).Value = WorksheetFunction.Min(R)
Sheet1.Cells(n, 9).Value = Sheet1.Cells(i - 1, 3).Value

Sheet1.Range(Sheet1.Cells(6, 3), Sheet1.Cells(i, 3)).Clear

i = 6
Sheet1.Cells(i, 3).Value = Sheet1.Range("C3").Value
i = i + 1
n = n + 1

' 5分後の時刻を算出
timenow = DateAdd("n", 5, Now())
End If


If STOP_B = False Then
Exit Sub
End If
Loop

End Sub

ウェイトはSleep(10)だと精度が甘いので、Sleep(100)にしました。
他の変更箇所はコメントにて。
これで合ってるかどうかは分かりませんが・・・。

この回答へのお礼

Wizard_Zeroさま
　早速のご回答ありがとうございます！
　１秒、５分おきに記録できるようになりました＾＾
　
　しかし、Ｅの列に日付と時間が記録されるようになっているのですが
　１時間ほど起動させておくと止まってしまうようです・・・
　大変申し訳ありませんが
　起動させている間は永遠に記録できるようにすることは
　可能なのでしょうか？？
　

お礼日時：2009/08/20 00:04

No.3 回答者： DreamyCat 回答日時： 2009/08/20 06:17

コードの中身はよく見ていないのですが

気になった点を。
While t < 300
Call Sleep(10)
DoEvents
t = t + 1
Wend
　上の例だとおよそ４.８秒になると思います。
下記の例ではおよそ３秒になると思います。
　（約１６ミリ秒の倍数でしか取得できないため。）
While t < 30
Call Sleep(90)　'80-95くらい
DoEvents
t = t + 1
Wend

詳細は省きますが、簡単に言うと高精度で取得するには
もうちょっと込み入ったことを追加しなければなりません。

この回答へのお礼

Dream cat さま
　　
　返答が遅くなり申し訳ありません。
　確かに若干秒数にずれがありました。　
　もっと勉強して改善していきたいと思います。
　ありがとうございました。

お礼日時：2009/09/02 13:30

No.2 回答者： ShowMeHow 回答日時： 2009/08/19 08:44

同じコンピューター上で、ほかの処理を同時に行わなければ問題はないと思うけど、

sleepとdoeventsよりontimeを使ったほうが、良いような気もする。

この回答へのお礼

ShowMeHowさま
　
　返答が遅くなり申し訳ありません。。
　色々調べているとontimeがいいようですね。
　ありがとうございました。

お礼日時：2009/09/02 13:28