taw********

2022/5/11 5:41

22回答

VBA初心者です。やりたい事が上手く出来ないので質問させて下さい。 A列には、乱数を割り振る関数が入っています。

VBA初心者です。やりたい事が上手く出来ないので質問させて下さい。 A列には、乱数を割り振る関数が入っています。 最終的に、C5~C8セルに、2,9,3,8 とか、9,22,0,4 みたいに数字が割り振られるようにしたいです。可能ならばループしている最中はドラムロールのように数字が徐々に増えていく様が表現出来たら助かります。 エラーで弾かれてしまいますが、コードも載せておきます。 詳しくは画像を参照お願いします。 ------------------------------------------------ sub macro() j = 0 k = 0 l = 0 m = 0 Do If Range("c9") = "" And Range("a5") <= Range("b5") Then j = j + 1 Range("c5") = j Loop If Range("c9") = "" And Range("a6") <= Range("b6") Then k = k + 1 Range("c6") = k Loop If Range("c9") = "" And Range("a7") <= Range("b7") Then l = l + 1 Range("c7") = l Loop If Range("c9") = "" And Range("a8") <= Range("b8") Then m = m + 1 Range("c8") = m Loop Range("c10") = j + k + l + m End If End If End If End If End Sub

画像

Visual Basic | Visual Basic・186閲覧・xmlns="http://www.w3.org/2000/svg">100

ベストアンサー

0
qgl********

カテゴリマスター

2022/5/11 9:08

こういうことでしょうか。 Sub sample() Dim j As Long, k As Long, l As Long, m As Long j = 0: k = 0: l = 0: m = 0 Do If Range("C9") = "" And Range("A5") <= Range("B5") And Range("C5") < 2 Then j = j + 1 Range("C5") = j End If If Range("C9") = "" And Range("A6") <= Range("B6") And Range("C6") < 9 Then k = k + 1 Range("C6") = k End If If Range("C9") = "" And Range("A7") <= Range("B7") And Range("C7") < 3 Then l = l + 1 Range("C7") = l End If If Range("C9") = "" And Range("A8") <= Range("B8") And Range("C8") < 8 Then m = m + 1 Range("C8") = m End If Range("C10") = j + k + l + m If j = 2 And k = 9 And l = 3 And m = 8 Then Exit Do '停止条件 Loop End Sub

taw********

質問者2022/5/11 9:51

日本語が下手ですいません。2,9,3,8という値は、あくまで一例としてなので、その値にしたい訳ではないです。 下記も一例ですが、 添付画像の青の部分で条件を満たしたらC5セルに+1加算し、Doの部分まで戻る。 添付画像の緑の部分で条件を満たしたらC8セルに+1加算し、Doの部分まで戻る。 添付画像の青の部分で条件を満たしたらC5セルに+1加算し、Doの部分まで戻る。 添付画像の４か所全てで条件を満たさなかったので、 以下のセルにこの値が入力される。 C5＝2、C6=0、C7=0、C8＝1　C9=3 このようにしたいです。

画像

その他の回答（1件）

0
ニャる

2022/5/12 14:17

一応、質問と同じコードを少し直したものを載せておきますが 希望通り動きそうですかね？ ＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿ #If Win64 Then Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) #Else Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) #End If Sub macro() j = 0 k = 0 l = 0 m = 0 Do If Range("c9") = "" And Range("a5") <= Range("b5") Then j = j + 1 Range("c5") = j ElseIf Range("c9") = "" And Range("a6") <= Range("b6") Then k = k + 1 Range("c6") = k ElseIf Range("c9") = "" And Range("a7") <= Range("b7") Then l = l + 1 Range("c7") = l ElseIf Range("c9") = "" And Range("a8") <= Range("b8") Then m = m + 1 Range("c8") = m Exit Do End If DoEvents Sleep 10 Loop Range("c10") = j + k + l + m End Sub ＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿ これを標準モジュールに書くかコピペしてみて下さい。 一番上の#も、ちゃんと付けて下さいね('ω')

taw********

質問者2022/5/12 15:21

ありがとうございます。C列の文字が消せなくなったり、ボタン登録して何度か同じ動作を繰り返そうとしても値が変わらず、連打しすぎたせいかフリーズしたり、マクロが開けなくなったり、Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)の部分が赤くなってしまったりします('ω')