VBAでランダムな並び替えをするには

質問

エクセルのシート１行目に１～４０の数字を連番で記入し、３行目に左のセルから順番にランダムに並べるマクロを以下のように書きましたが、動きません。どこが違っているのでしょうか、ご指導いただけますか。

1 　2 　3 　 4 　5 ・・・・40
↓　 ↓　 ↓　 ↓　 ↓
21 35 33 14 20 ・・・・

以下マクロ

'1から40までの数を一列に並べる。
for i=1 to 40
cells(1,i)=i:cells(3,i)=""
next i

for i=1 To 40
msgbox(40-i+1&"枚から1枚選びます")

'1から40までの数をランダムに1つ発生させる。
　　　x=int(rnd()*40)) +1

cells(3,1)=cells(1,x)
for j=x+1 to 40
cells(1,j-1)=cells(1,j)
next j
cells(1-j,x)=""
msgbox("確認して下さい")
cells(3,1)=cells(6,4)
cells(6,4)=""
x=int(rnd()*39) +1
　　　cells(3,2)=cells(1,x)
　　　　next i

回答No.6

Wendy02

こんばんは。

#3の回答者です。私の書いたものは、きちんと読まれてはいないような気がします。文句を付けるわけではなくて、段階的に覚えるべきものがあります。それを無視して、いきなり上の段階のコードを作ろうとしても、結局、うまくいきません。

もう少し、基礎的なものを経てからのほうがよいではありませんか？

まず、勉強するつもりなら、ヘルプで、Rnd()関数の部分を読んだほうがよいです。今、こまごま、こちらはお教えするつもりがありません。

それに、ほとんど、似たようなパターンが出てきませんか。

例えば、
29　　21　　24　　11　　12　　33　

もし、そうなら、それは乱数になっていませんね。関数ジェネレータで同じものを使っているからです。それと、自分のコードを直してもらうというのは無理だと思います。

私も書いてあげないと、私の言っていることは理解しないと思います。

以下は、シャフルします。そして、選んだ後に、もう一度、シャフルします。もしかしたら、一様乱数のパターンを変えてしまうと、同じものが出る可能性があります。それは、何度もやってみないとなんとも分かりません。Randomize はループで繰り返すものではありませんが、一度は使わないといけません。

細かい部分は、良くチェックしていませんが、こんな感じになるのではないでしょうか。

'標準モジュール
'Option Explicit

Sub RandomGenerate()
　　Dim i As Long
　　Dim j As Variant
　　Dim ar As Variant
　　Dim colNo As New Collection
　　Range("A1:AN1").ClearContents
　　Range("A3:AN3").ClearContents

　　Shuffle colNo, 40, True
　　ar = Col2Ary(colNo)
　　Range("A1").Resize(, colNo.Count).Value = ar

　　For i = 0 To 39
mLoop:
　　　　j = Application.InputBox(40 - i & "回あります。", "ランダム選択", Type:=2)
　　　　If Not IsNumeric(j) Or VarType(j) = vbBoolean Or j = "" Then Exit For
　　　　If CLng(j) > (40 - i) Or CLng(j) < 1 Then
　　　　　　MsgBox "数字は、1 から" & 40 - i & "までの中から選んでください。", 48
　　　　　　GoTo mLoop
　　　　End If
　　　　If MsgBox("あなたは、「" & colNo(CLng(j)) & "」を選んでいます。" & vbNewLine & _
　　　　　　"それでよいのですか？", vbQuestion + vbOKCancel) = vbCancel Then
　　　　　　GoTo mLoop
　　　　End If
　　　　Cells(3, i + 1).Value = colNo(CLng(j))
　　　　Range("A1:AN1").ClearContents
　　　　colNo.Remove (CLng(j))
　　　　If 40 - (i + 1) = 0 Then Exit Sub
　　　　Shuffle colNo, 40 - (i + 1), False
　　　　ar = Col2Ary(colNo)
　　　　Range("A1").Resize(, colNo.Count).Value = ar
　　Next i
End Sub

Function Shuffle(ByRef colNo As Collection, no As Integer, flg As Boolean)
　　Dim i As Long
　　Dim Nos1() As Variant
　　ReDim Nos1(1, no - 1)

　　Randomize
　　For i = 0 To no - 1
　　　　Nos1(1, i) = Rnd()
　　　　If flg = True Then
　　　　　　Nos1(0, i) = i + 1
　　　　Else
　　　　　　Nos1(0, i) = colNo.Item(i + 1)
　　　　End If
　　Next i
　　B_Sort Nos1
　　If flg = False Then
　　For i = no To 1 Step -1
　　　colNo.Remove (i)
　　Next i
　　End If
　　For i = 0 To no - 1
　　　 If flg Then
　　　　colNo.Add Nos1(0, i)
　　　 Else
　　　　colNo.Add Nos1(0, i)
　　　 End If
　　Next i
End Function
Sub B_Sort(ar() As Variant)
　Dim u As Long
　Dim i As Long
　Dim j As Long
　Dim t1 As Variant
　Dim t2 As Variant
　u = UBound(ar(), 2)
　i = LBound(ar(), 2)
　Do While i < u
　　j = u
　　Do While j > i
　　　If ar(1, j) < ar(1, i) Then '昇順
　　　　t1 = ar(0, j)
　　　　t2 = ar(1, j)
　　　　ar(0, j) = ar(0, i)
　　　　ar(1, j) = ar(1, i)
　　　　ar(0, i) = t1
　　　　ar(1, i) = t2
　　　End If
　　　j = j - 1
　　Loop
　　i = i + 1
　Loop
End Sub
Function Col2Ary(coll As Variant) As Variant
Dim i As Long
Dim cl As Variant
ReDim ary(coll.Count - 1)
For Each cl In coll
　ary(i) = cl
　i = i + 1
Next cl
Col2Ary = ary
End Function

お礼

ご丁寧に解説してくださってありがとうございます。わかりました。