並行処理は出来ないか

Option Explicit
Sub sampl1()
Dim n As Long
For n = 1 To 10000
DoEvents
DoEvents
Range("B2").Value = n
Next n
End Sub
Sub sampl2()
Dim m As Long
For m = 1 To 10000
DoEvents
DoEvents
Range("C2").Value = m
Next m
End Sub
Sub sampl3()
Dim p As Long
For p = 1 To 10000
DoEvents
DoEvents
Range("D2").Value = p
Next p
End Sub

上記のようなコードを書き試していますが、
出来ません。
（それぞれのプロシージャーにボタンを貼り、ボタンを押してゆく）

押せるのですが、それまで動いていた処理が中断してしまいます。
それぞれのプロシージャー（例で3個）を平行で動かすことは無理なのでしょうか。

宜しくお願いします。

windows7
excel2003

No.1 ベストアンサー 回答者： rukaandkaito 回答日時： 2019/07/25 14:14

カウンタを外出しにして各ボタン毎にフラグの設定をすれば出来ますよ！

Sheet1
--------------------------------------------------------------------------------
Private Sub CommandButton1_Click()
　Call Sample(1)
End Sub

Private Sub CommandButton2_Click()
　Call Sample(2)
End Sub

Private Sub CommandButton3_Click()
　Call Sample(3)
End Sub
--------------------------------------------------------------------------------
標準モジュール
--------------------------------------------------------------------------------
Option Explicit
Public blnA(3) As Boolean
Public cntA(3) As Integer

Public Sub Sample(btnA As Integer)
　Dim i As Integer

　blnA(btnA) = True

　Do Until blnA(1) = False And _
　　　　　 blnA(2) = False And _
　　　　　 blnA(3) = False

　　For i = 1 To 3
　　　If blnA(i) = True And cntA(i) < 10000 Then cntA(i) = cntA(i) + 1
　　　If blnA(i) = True Then Sheet1.Cells(2, i + 1).Value = cntA(i)
　　　DoEvents
　　　If cntA(i) >= 10000 Then blnA(i) = False
　　Next i
　Loop

End Sub
--------------------------------------------------------------------------------

ボタンの数が増えてもカウンタのみで対応出来ます
また、それぞれのカウンタに対して終了ボタンで途中停止する場合には
『blnA(i) = False』だけで対応出来ます
全てのカウンタを初期化するために初期処理を追加することをお薦めします
面倒な場合には『Worksheet_Activate』にでも記載しましょう
--------------------------------------------------------------------------------
Public Sub Init
　Dim i AS Integer

　For i = 1 to 3
　　blnA(i) = False
　　cntA(i) = 0
　Next i
--------------------------------------------------------------------------------
お試しください

この回答へのお礼

早速有り難うございました。
見事に出来ました。

今後の道が開けました。
（今回の質問はそのための例でした）
お世話になりました。

お礼日時：2019/07/25 17:01