実行中のマクロで無限ループを壊さずに手動でセル値を変更しますか？

Question

無限ループを持つマクロを作りたいです。このループでは、毎秒セルの値を変更します。

マクロ（コード内のAlpha変数）を停止せずに手動でセルを変更したいと考えています。可能にするための回避策はありますか？またはスレッド？ここ

は私のコードです：

Sub test() 
    Dim wb As Workbook 
    Dim ws As Worksheet 
    Dim i As Integer 
    i = 0 

    Set wb = ActiveWorkbook 
    Set ws = wb.Sheets("Sheet1") 
    Set P1 = ws.Range("A1") 
    Set Q1 = ws.Range("A2") 
    Set Alpha = ws.Range("G1") 
On Error GoTo CleanExit 

    If Target.Address = "$Q$21" Then 
     Application.EnableEvents = False 
    End If 
CleanExit: 

    Application.EnableEvents = True 
     While i = 0 

     P1.Value = 100 + WorksheetFunction.RandBetween(1, 6) 
      Q1.Value = Alpha 

     Pause (1) 

     Wend 
    On Error GoTo 0 

End Sub 

、ここでは、一時停止機能である：

Public Function Pause(NumberOfSeconds As Variant) 
    On Error GoTo Error_GoTo 

    Dim PauseTime As Variant 
    Dim Start As Variant 
    Dim Elapsed As Variant 

    PauseTime = NumberOfSeconds 
    Start = Timer 
    Elapsed = 0 
    Do While Timer < Start + PauseTime 
     Elapsed = Elapsed + 1 
     If Timer = 0 Then 
      ' Crossing midnight 
      PauseTime = PauseTime - Elapsed 
      Start = 0 
      Elapsed = 0 
     End If 
     DoEvents 
    Loop 

Exit_GoTo: 
    On Error GoTo 0 
    Exit Function 
Error_GoTo: 
    Debug.Print Err.Number, Err.Description, Erl 
    GoTo Exit_GoTo 
End Function 

私は、セルを選択すると、私はエラー1004「アプリケーション定義またはオブジェクト定義のエラーを取得します"

基本的に、私は油圧ポンプの機能をシミュレートしたい、角度αが変化する。アルファが変化すると、他のパラメータ（圧力、流量など）が変化します。そのため、毎秒何らかのエラーでパラメータの連続ループを作成したい（ランダム関数を使用）。アルファが（手動で）変更されると、パラメータが値を変更します。これが主なアイデアです。

Answer 1

ワークシートのデータを使用して計算を繰り返す場合は、次のような構成を使用します。 Application.OnTimeイベントを使用して、何らかの条件が満たされるまで（または停止優先が呼び出されるまで）、プロシージャを繰り返し実行します（毎秒〜）。ワークシートにデータを入力できることを示すために単純なコードを使用しました。

Option Explicit 
Private Running As Boolean 

Sub Start_Timer() 
    Running = True 
    Application.OnTime Now + TimeSerial(0, 0, 1), "Timed_Code" 
End Sub 

Sub Stop_Timer() 
    Running = False 
End Sub 

Sub Timed_Code() 
    If [A1] = False Then Call Stop_Timer 
    [C1] = [B1] + Application.WorksheetFunction.RandBetween(1, 6) 

    If Running Then Application.OnTime Now + TimeSerial(0, 0, 1), "Timed_Code" 
End Sub