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.5

mitarashi · ベストアンサー

>３行目に並ばなくて皆消えていくものですね。
確認不足で済みません。アクティブシートでなく、一番左側のシートに入ってしまっていると思います。
さて、追加のご質問の件ですが、下記でいかがでしょうか。
>D6のセルに、ランダムに発生させた数を表示させて
Sub test()
Dim i As Long, x As Long

For i = 1 To 40
Cells(1, i) = i: Cells(3, i) = ""
Sheets(2).Cells(1, i) = i
Next i
For i = 1 To 40
MsgBox (Str(40 - i + 1) & "枚から1枚選びます")
x = Int(Rnd() * (40 - i + 1)) + 1
Range("d6").Value = x
MsgBox ("確認して下さい")
Cells(3, i).Value = Sheets(2).Cells(1, x).Value
Cells(1, Sheets(2).Cells(1, x).Value).Value = ""
Sheets(2).Cells(1, x).Delete Shift:=xlToLeft
Next i
End Sub
中断させるには、Ctrl+Breakキーを押すと止まります。
そういう意味でなくて、MsgBoxの所で分岐して止めたいという様な意味でしたら、参考URLなどをご覧下さ
い。
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_msgbox.html

お礼

URLまでありがとうございました。お陰様で私の思っていた通りに数字が動きました。
SubとかIntとかStrとか省略語だと思うのですが、このような用語がわかりやすく解説してあるサイトまたは本などありますでしょうか。インターネットでサイトを探してみましたが、初心者の私にはどうも適するものが見当たりませんでした。

回答No.8

Wendy02

>#5の部分訂正
#6 でした。たびたびすみません。

なお、1000個程度までのレベルでの乱数を作るのは、なかなか難しいです。特に、今回は、40個で、シャフルしてあげないと同じパターンが発生するのではないかと思います。そのまま、Rnd()で数字を作っても、似たようなパターンが出てくるように感じています。その場合は、同じパターンが出たときに、排除するようなプログラムを作りますが、それが、意外にややこしい内容になってしまいます。

なお、Randomize+Rnd()のほうが、ワークシート関数を使うよりも、乱数の発生の組み合わせの頻度は高いようです。

回答No.7

Wendy02

#5の部分訂正
関数ジェネレータ　→乱数ジェネレータ

お礼

訂正ありがとうございます。

回答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

お礼

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

回答No.4

mitarashi

#1です。
>sheet1だけでできないでしょうか。
話を簡単にするために、Sheet2を使っているだけで、Sheet1の65536行を使っていただいても、一向に構いません。
作業行を使わないコードも呈示しておきます。昔作ったものと合成しているので、記述に統一性が無いですが、話の種という事で．．．
Sub test()
Dim numbers As New Collection
Dim destRange As Range
Dim pickUp As Long
Dim i As Long

For i = 1 To 40
Cells(1, i) = i: Cells(3, i) = ""
numbers.Add Item:=i
Next i
Set destRange = Sheets(1).Range("a3")
Do While numbers.Count >= 1
MsgBox (Str(numbers.Count) & "枚から1枚選びます")
pickUp = Int(Rnd() * numbers.Count) + 1
destRange.Value = numbers(pickUp)
numbers.Remove (pickUp)
Cells(1, destRange.Value).Value = ""
Set destRange = destRange.Offset(0, 1)
Loop
End Sub
#1の記述はCellをCollectionの一種として使う事で、上記コードのような面倒が要らなくなっています。

補足

ありがとうございます。
３行目に並ばなくて皆消えていくものですね。

最初に提示してくださったものが簡潔でよいと思いました。
なお、D6のセルに、ランダムに発生させた数を表示させてメッセージボックスで「確認して下さい」が出てOKしてから、３行目に表示させるのは、どう書けばよいのでしょうか。

ちなみに実行しているこのプログラムを中断するのはどうすればよいのでしょうか。

回答No.3

Wendy02

こんばんは。

>どこが違っているのでしょうか、ご指導いただけますか。
そのコードでは無理ではありませんか？
簡易ゲームでも作るのでしょうか？

msgbox(40-i+1&"枚から1枚選びます")
msgbox("確認して下さい")

>くじを引くたびに１枚ずつくじが減っていく中からランダムにくじを引く状況をシートの上で実現するイメージなんですが。

最初のコードは、まったく、そういうようにはなっていないと思います。ユーザーに選ばせるつもりなら、MsgBox ではなくて、InputBox だと思います。それぐらいは初歩的なレベルですから、教えるまでもないと思います。それから、一般的には、その場合は、Collection オブジェクトを使いますが、中級以上です。また、その時、乱数を使うというなら、特別なコードが必要になります。

しかし、ユーザーが40枚のカードを1枚ずつ引いていくようなスタイルでは？それ自体は、乱数の発生とは違うはずですし、乱数発生のコードも、重複を許さないものは、質問で書いている内容では違っています。

最初の設計の部分から、もう一度、手順を考え直したほうがよいのではないかと思います。

お礼

ありがとうございます。
初心者なので、これからがんばります。

回答No.2

n-jun

Sub try()
Dim i As Long, j As Long
Dim x As Integer

'１行目に１～４０の数値をセット
For i = 1 To 40
Cells(1, i).Value = i
Cells(3, i).Value = ""
Next i

Do

'１～４０の乱数発生
x = Int(Rnd() * 40 + 1)

'まだ発生していない乱数だった場合、
If Cells(1, x).Value <> "" Then

'１行目の該当乱数のセルを消す
Cells(1, x).Value = ""

'３行目の列数を１つずつ移動
j = j + 1
'移動したセルに乱数を代入
Cells(3, j).Value = x

End If

'乱数の代入を４０回繰り返したらループを抜ける
Loop Until j = 40

End Sub

一部でもご参考になれば。

お礼

ありがとうございました。

補足

くじを引くたびに１枚ずつくじが減っていく中からランダムにくじを引く状況をシートの上で実現するイメージなんですが。

回答No.1

mitarashi

40個の数字から、ランダムに、重複無く抜き出して、かつ抜き出した数字のセルは空白にしたいという事でしょうか。
「重複無く」実現のために、エクセルの機能を活かした作業行を別シートに設けるのはいかがでしょうか。
Sub test()
For i = 1 To 40
Cells(1, i) = i: Cells(3, i) = ""
Sheets(2).Cells(1, i) = i
Next i

For i = 1 To 40
MsgBox (Str(40 - i + 1) & "枚から1枚選びます")
x = Int(Rnd() * (40 - i + 1)) + 1
Cells(3, i).Value = Sheets(2).Cells(1, x).Value
Cells(1, Sheets(2).Cells(1, x).Value).Value = ""
MsgBox ("確認して下さい")
Sheets(2).Cells(1, x).Delete Shift:=xlToLeft
Next i
End Sub

補足

くじを引くたびに１枚ずつくじが減っていく中からランダムにくじを引く状況をシートの上で実現するイメージなんですが。
sheet1だけでできないでしょうか。