重複しない乱数生成のVBAマクロについて

添付の写真のように、1クリックでくじの列に乱数を生成させたいです。
＜条件など＞
・Ｇ列にある人数が乱数の最大値になる。
・Ｂ列の性別をもとに処理を分岐し、「男」用または「女」用の乱数配列を選択。
・Ｃ列に生成した乱数を書込。

とりあえず、思いつくままコードを書いてみたのですが、正しく動作しない（フリーズしてしまう）ので、詳しい方のお知恵をお借りしたいと思い、質問しました。

=========================
Sub NumGen_Click()
Dim i, i1, i2, num1, num2, d, d1, d2 As Integer '変数i, i1, i2, num1, num2, d, d1, d2 をInt型で定義
d1 = Range("G2").Value 'セルG2から人数の最大値取得
d2 = Range("G3").Value 'セルG3から人数の最大値取得
d = d1 + d2 '人数の合計
Dim id1() As Integer '空の動的配列id1()を定義
Dim id2() As Integer '空の動的配列id2()を定義
ReDim id1(d1) As Integer '動的配列の最大を d1 までにするよう再定義
ReDim id2(d2) As Integer '動的配列の最大を d2 までにするよう再定義
Randomize '乱数表初期化

'
' TODO IF文による条件分岐？
'
'
For i = 1 To d
If Cells(i + 3, 2).Value = "男" Then
For i1 = 1 To d1 '1～d1までの繰り返し
Do
num1 = Int(Rnd() * d1 + 1) '最大値dまでの乱数を生成
Loop Until id1(num1) = 0
Cells(i1 + 4, 3) = num1 'C4から縦に結果を出力
id1(num1) = 1 '処理済みの配列には1を代入する
Next i1
ElseIf Cells(i + 3, 2).Value = "女" Then
For i2 = 1 To d2 '1～d2までの繰り返し
Do
num2 = Int(Rnd() * d2 + 1) '最大値d2までの乱数を生成
Loop Until id2(num2) = 0
Cells(i2 + 4, 3) = num2
id2(num2) = 1
Next i2
Else

End If
Next i
End Sub
=========================
Ｆ８でステップ実行したときに、Do～Loopで抜け出せないみたいなのでそこが原因だと思ってます・・・別の処理の仕方があれば、教えていただきたいです。

No.4 ベストアンサー 回答者： 白亜気 回答日時： 2020/07/26 15:11

こんなのでも良いのでしょうか？

Sub 四角形角を丸くする1_Click()
nua = WorksheetFunction.CountA(Range(Cells(4, 2), Cells(200, 2)))
nuf = WorksheetFunction.CountIf(Range(Cells(4, 2), Cells(200, 2)), "女")
num = nua - nuf
Dim ram(260), raf(260)
For i = 4 To 200
If Cells(i, 2) = "男" Then
ram(i) = Int(Rnd() * 100000) * 1000 + i
ElseIf Cells(i, 2) = "女" Then
raf(i) = Int(Rnd() * 100000) * 1000 + i
End If
Next
For i = 1 To num
ir = WorksheetFunction.Large(ram, i) Mod 1000
Cells(ir, 3) = i
Next
For i = 1 To nuf
ir = WorksheetFunction.Large(raf, i) Mod 1000
Cells(ir, 3) = i
Next
End Sub

この回答へのお礼

回答ありがとうございます。
自分が思っていたような動作になりました。

お礼日時：2020/07/26 20:18

No.6 回答者： tom04 回答日時： 2020/07/26 19:10

No.2です。

余計なコトをしていたのですね。
結局C列だけの操作で良い！という解釈で・・・

Sub Sample2()
　Dim i As Long
　Dim k As Long
　Dim myNum As Long
　Dim myMax
　Dim myFlg() As Boolean

　　For k = 2 To Cells(Rows.Count, "F").End(xlUp).Row
　　　myMax = Cells(k, "G")
　　　ReDim myFlg(1 To myMax)
　　　Randomize
　　　　For i = 4 To Cells(Rows.Count, "A").End(xlUp).Row
　　　　　If Cells(i, "B") = Cells(k, "F") Then
　　　　　　Do
　　　　　　　myNum = Int(myMax * Rnd + 1)
　　　　　　Loop Until myFlg(myNum) = False
　　　　　　　Cells(i, "C") = myNum
　　　　　　　myFlg(myNum) = True
　　　　　End If
　　　　Next i
　　Next k
End Sub

これではどうでしょうか？m(_ _)m

この回答へのお礼

回答ありがとうございます。
No.4の方と同様に思ったような動作になりました。

お礼日時：2020/07/26 20:17

No.5 回答者： ママチャリ 回答日時： 2020/07/26 16:25

「処理済みの配列には1を代入する」を実行した後、Exit Forで、そのループを抜ける必要があると思います（2ヶ所）。

求めたユニークな乱数をセルに代入していますが（2ヶ所）、代入先セルの位置指定が間違っていませんか？

この回答へのお礼

回答ありがとうございます。

おっしゃる位置でExit Forを入れて、For～Nextを抜けてみたんですが、うまく実行できなかったもので(T_T)
位置指定はあとで直そうかなと・・・すいません。

お礼日時：2020/07/26 20:09

No.3 回答者： めぐみん_ 回答日時： 2020/07/26 14:37

初級レベルなのでベテランさんにはかないませんけど、要するに男女別々で１～人数までの数値をグループとして作成しＢ列の値に応じて各々のグループから適当に『くじを引いて』Ｃ列に書き出せば良いのでしょうか？

Ｄ列は数式によりＢ・Ｃ列の連結値を表示するようになっていると。

この回答へのお礼

回答ありがとうございます。
その解釈で合っています。

お礼日時：2020/07/26 20:05

No.2 回答者： tom04 回答日時： 2020/07/25 23:23

こんばんは！

タイトルが「重複しない乱数・・・」となっていますが、C列の「くじ」が重複しない！
ではなく、男女それぞれで重複しない！（すなわち「くじ」の重複は男女別ならOK）という解釈です。

A列に関しては不明なので無視しています。

Sub Sample1()
　Dim i As Long
　Dim myNum As Long
　Dim myMax As Long
　Dim lastRow As Long
　Dim myFlg() As Boolean

　　'//▼B4～D列最終行までを一旦消去//
　　lastRow = Cells(Rows.Count, "B").End(xlUp).Row
　　　If lastRow > 3 Then
　　　　Range(Cells(4, "B"), Cells(lastRow, "D")).ClearContents
　　　End If

　　'//▼ココから操作//
　　myMax = Range("G2") + Range("G3")
　　ReDim myFlg(1 To myMax)
　　　Randomize
　　　　For i = 1 To myMax
　　　　　Do
　　　　　　myNum = Int(myMax * Rnd + 1)
　　　　　Loop Until myFlg(myNum) = False

　　　　　If myNum <= Range("G2") Then
　　　　　　With Cells(i + 3, "B")
　　　　　　　.Value = Range("F2")
　　　　　　　.Offset(, 1) = myNum
　　　　　　　.Offset(, 2) = Range("F2") & myNum
　　　　　　End With
　　　　　Else
　　　　　　With Cells(i + 3, "B")
　　　　　　　.Value = Range("F3")
　　　　　　　.Offset(, 1) = myMax - myNum + 1
　　　　　　　.Offset(, 2) = Range("F3") & myMax - myNum + 1
　　　　　　End With
　　　　　End If
　　　　　myFlg(myNum) = True
　　　　Next i
End Sub

上記マクロを実行すると
↓の画像のような感じになります。m(_ _)m

この回答へのお礼

回答ありがとうございます。

＞＞ではなく、男女それぞれで重複しない！（すなわち「くじ」の重複は男女別ならOK）という解釈です。
質問文が言葉足らずで、申し訳ありません。おっしゃる通りの解釈で正しいです。

Ｄ列のセルには、関数が入っているので、'//▼B4～D列最終行までを一旦消去//　の処理と .Offset(,2) のところはコメントアウトして、動作させました。（Excel 2019にて）
確かに乱数の生成は希望したようになっていますが、連続でボタンを押して実行すると、性別のところまで書き換わってしまうようです。

Ａ列は名前、Ｂ列は、その人の性別を入力（値貼付）するので、書き換わってほしくないのです。

お礼日時：2020/07/26 13:13

No.1 回答者： kmee 回答日時： 2020/07/25 22:27

For i1 = 1 To d1 '1～d1までの繰り返し

Do
〜
Next i1

を
For i = 1 To d
で繰り返しています。

つまり
i=1 で B4が男→ 1～d1までの繰り返して 1〜d1の乱数を全て使いつくす(つまり id1(?) = 1 )
の後で
i=3 で B6が男→ 1〜d1の乱数を発生させようとする→全て「使用済み」になっている( id1(?) = 1 )→ループから脱出できない
となっています。

For i1 = 1 To d1 '1～d1までの繰り返し
にはどんな意図があるのでしょうか?



直接は関係ないですが。
> Dim i, i1, i2, num1, num2, d, d1, d2 As Integer '変数i, i1, i2, num1, num2, d, d1, d2 をInt型で定義
この書き方だと、 As Integer は d2 にのみ有効です。
それ以外はVariant型になります。つまり
Dim i As Variant, i1 As Variant, i2 As Variant, num1 As Variant, num2 As Variant, d As Variant, d1 As Variant, d2 As Integer
と同じです。


重複しない乱数を発生させる方法は他にも
・配列に使用する値を入れる→配列をシャフルする(ランダムに順番を入れかえる)
があります

この回答へのお礼

回答ありがとうございます。

＞＞For i1 = 1 To d1 '1～d1までの繰り返しにはどんな意図があるのでしょうか?
もともと別のコード（人数d1分の乱数を生成して、別のセルに書き出す）を流用したものです。
「男」の重複しない乱数配列の生成のつもりで書いてました。（「女」も同様です。）

やりたいことは、先にも書いたように、性別によって条件分岐し、「男」用の乱数配列または「女」用の乱数配列から1つの乱数を取り出し、隣のセルに書き出すようにしたいです。

お礼日時：2020/07/25 23:00