１秒毎にセルの値を１ずつ増やしたいのですが

いつも難しいマクロでｇｏｏの皆さんには大変お世話になっています。
よろしくお願いします。
エクセルで、シート上でクリックを一回したらセルの値が１秒ごとに１ずつ増えるようにしたいのです。再度クリックしたらカウントを中断して０に戻りまた１秒ごとに１ずつセルの値を増やしたいです。数値の最高値は別のセルに書いてある数値です。
ちょっと難問ですがどうかよろしくお願いします。

No.1 ベストアンサー 回答者： siddhaartha 回答日時： 2006/11/01 15:38

要件に一番近そうなマクロを作ってみました。

ただし数点制約があります。
・ExcelVBAではマルチスレッドが実現できないので１セル毎でしかカウントできません。
・クリックイベントは無いので、ボタン(CommandButton1)のクリックイベントで
　カウントのON／OFFを行っています。

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

Public blCountFlg As Boolean

Private Sub CommandButton1_Click()
blCountFlg = Not blCountFlg
Call prc_Count(ActiveCell, Cells(1, 1))
End Sub

Private Sub prc_Count(ByVal Target As Range, MaxCount As Long)
Dim lnStart As Long
Dim lnCount As Long
lnStart = GetTickCount

Do While (blCountFlg And lnCount < MaxCount)
Sleep (100)
lnCount = (GetTickCount - lnStart) / 1000
Target.Value = lnCount
DoEvents
Loop
End Sub

No.3 回答者： nicotinism 回答日時： 2006/11/01 16:53

あんまり、パッとしない案です。

シート１のイベントに

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'A1 微調整用
'B1 設定秒数
'C1 開始
'C2 停止
'D1 経過秒表示
'E1 開始時間
'F1 終了時間

Dim i As Long
Dim tt As Single
Dim tA As Single

If Target.Address <> "$C$1" Then Exit Sub

Range("c1").Value = "Start"
Range("c2").Value = "Stop"
Range("d1") = 0
Range("F1") = ""
Range("G1") = ""

tA = Range("A1").Value
Range("E1") = Timer

Do Until i > Range("B1").Value - 1
　　If ActiveCell.Address = "$C$2" Then
　　　　Exit Do
　　　　Exit Sub
　　End If
　　tt = Timer
　　　　Do While Timer < tt + tA
　　　　　　DoEvents　　　　　　　　' 他のプロセスに制御を渡します。
　　　　Loop
　　i = i + 1
　　Range("D1") = i
Loop
Range("F1") = Timer
Range("G1") = "誤差 " & Range("F1") - Range("E1") - Range("B1").Value
End Sub

んで
セル A1 に 1
セル B1 に 10
を入れてセルC1を選択してみてください。停止ははC2を選択。

No.2 回答者： toshi_2000 回答日時： 2006/11/01 15:55

マクロは、次の通りです。

（数値の最高値には未対応）

Sub Test()
If Cells(1, 1) <> 0 Then
Cells(1, 1) = 0
Application.OnTime Now + TimeValue("00:00:01"), "test2", SCHEDULE:=False
End If
Test2
End Sub

Sub Test2()
Cells(1, 1) = Cells(1, 1) + 1
Application.OnTime Now + TimeValue("00:00:01"), "test2"
End Sub