６つの番号が全て違う番号で出る乱数にするには？
解決ボタンを押すと、Label1〜6に６つの番号が出るようにしたいのです。
それぞれ異なった番号で、一度に重複番号が出ないようにしたいのです。
ロト６みたいに、１〜４３の番号を６つランダムに出したいというわけです。こうゆう時はどうすればいいんでしょうか？
Private Sub Button1_Click(略) Handles Button1.Click
Dim L1, L2, L3, L4, L5, L6 As Integer
Randomize()
L1 = Int(Rnd(1) * 43 + 1)
L2 = Int(Rnd(1) * 43 + 1)
L3 = Int(Rnd(1) * 43 + 1)
L4 = Int(Rnd(1) * 43 + 1)
L5 = Int(Rnd(1) * 43 + 1)
L6 = Int(Rnd(1) * 43 + 1)
La1.Text = L1
La2.Text = L2
La3.Text = L3
La4.Text = L4
La5.Text = L5
La6.Text = L6
End Sub
このような感じだと同じ番号が出てしまいます。
あと、小さい番号順に並べたいんです。
「26 14 16 4 43 2」とあったら「2 4 14 16 26 43」と。
・重複番号が出ないようにしたい
案１ トランプのシャッフルの要領で考えてください
案２ 同じ値が出たらまた乱数を発生させるようにする
どちらの案も「出た値を保存しておく」ことはかわりません
・小さい番号順に並べたい
案１ ソート法を調べてください
過去ログを検索してみてやってみましたが
今の所はこんな感じで大丈夫だと思います。
im L1, L2, L3, L4, L5, L6 As Integer
Randomize()
Do Until L1 <> L2 And L1 <> L3 And L1 <> L4 And L1 <> L5 And L1 <> L6 _
And L2 <> L3 And L2 <> L4 And L2 <> L5 And L2 <> L6 _
And L3 <> L4 And L3 <> L5 And L3 <> L6 _
And L4 <> L5 And L4 <> L6 _
And L5 <> L6
L1 = Int(Rnd(1) * 43 + 1)
L2 = Int(Rnd(1) * 43 + 1)
L3 = Int(Rnd(1) * 43 + 1)
L4 = Int(Rnd(1) * 43 + 1)
L5 = Int(Rnd(1) * 43 + 1)
L6 = Int(Rnd(1) * 43 + 1)
Te1.Text = L1
Te2.Text = L2
Te3.Text = L3
Te4.Text = L4
Te5.Text = L5
Te6.Text = L6
Loop
※考えてみたら「出た値を保存しておく」は素直に納得できない部分かもしれませんね。
> 今の所はこんな感じで大丈夫だと思います。
多少冗長ですが、まぁいいのではないかと。
ちょっと話がずれますが
Dim L1, L2, L3, L4, L5, L6 As Integer
は、
L6 は、integerですが
後は、Variantです。
Sub test()
Dim L1, L2, L3, L4, L5, L6 As Integer
L1 = "タタタ" '<----モンダイナシ Variant
L6 = 123
L6 = "アアア" '<---- エラー
End Sub
こんにちは良です。
ＶＢ.NET2003
でやってみたのですが
こんなのはどうでしょう？
もっとコードを簡単にできそうなんですが。
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim L(5) As Integer
Dim shtCnt As Short
Randomize()
Do Until L(0) <> L(1) And L(0) <> L(2) And L(0) <> L(3) And L(0) <> L(4) And L(0) <> L(5) _
And L(1) <> L(2) And L(1) <> L(3) And L(1) <> L(4) And L(1) <> L(5) _
And L(2) <> L(3) And L(2) <> L(4) And L(2) <> L(5) _
And L(3) <> L(4) And L(3) <> L(5) _
And L(4) <> L(5)
For shtCnt = 1 To 6
L(shtCnt - 1) = CInt(Rnd(1) * 43 + 1)
Next
Loop
Array.Sort(L)
Me.TextBox1.Text = L(0)
Me.TextBox2.Text = L(1)
Me.TextBox3.Text = L(2)
Me.TextBox4.Text = L(3)
Me.TextBox5.Text = L(4)
Me.TextBox6.Text = L(5)
End Sub
あ！インデントがめちゃくちゃだ。適当にインデントをつけてください。
やっぱりインデントそんなにめちゃくちゃではないかも。
ＶＢ.NET2003
はオートインデントなので・・
Sinyaさん
> Dim L1, L2, L3, L4, L5, L6 As Integer
> は、
> L6 は、integerですが
> 後は、Variantです。
そうですか？
見た目.NETっぽいので、違うかもしれませんよ？
良さん
> もっとコードを簡単にできそうなんですが。
っ[ せっかく配列を使っているのならば… ]
という感じですか
/*
今回は次のような段階を踏むプログラムを作ればいいのではないかと思います
１ １〜４３までの整数値の中で重複しない乱数を６個発生させる
＝シャッフル
２ ６個の乱数を昇順で取り出せるようにインデックスを改変させる
＝ソート
なので、次のようにしてみました。
(VB6)
Private Sub Form_Load()
Dim v As Variant
Dim p() As Integer
Randomize
p = GetRandoms(1, 49, 6)
For Each v In p
Debug.Print v;
Next
Debug.Print
Call Sort(p)
For Each v In p
Debug.Print v;
Next
Debug.Print
End Sub
Function GetRandoms(ByVal min As Integer, ByVal max As Integer, ByVal cnt As Integer) As Integer()
'min〜maxの範囲に在る整数を、ランダムのcnt個拾った配列を返す
Const sflcnt As Integer = 10240
Dim i As Integer
Dim tmp As Integer
Dim p1 As Integer
Dim p2 As Integer
Dim dom() As Integer
Dim ret() As Integer
'引数チェック
If max < min Then
'乱数の値域が不正
'どうするかは VB さんの思うとおり
Err.Raise "乱数の範囲が不正です"
ElseIf max - min + 1 < cnt Then
'乱数の値域よりも、取りうる数が多いので必ず重複が起こる
'どうするかは VB さんの思うとおり
Err.Raise vbObjectError, , "乱数の範囲以上の大きさの戻り値が必要です"
End If
'配列を作る
ReDim dom(min To max)
ReDim ret(1 To cnt)
'domを作り、シャッフルする
For i = min To max
dom(i) = i
Next
For i = 1 To sflcnt
p1 = Int((max - min + 1) * Rnd + min)
p2 = Int((max - min + 1) * Rnd + min)
tmp = dom(p1)
dom(p1) = dom(p2)
dom(p2) = tmp
Next
'retに、シャッフルした配列の先頭cnt個を入れる
For i = 1 To cnt
ret(i) = dom(LBound(dom) + (i - 1))
Next
'戻り値を設定して戻る
GetRandoms = ret
End Function
Sub Sort(ByRef data() As Integer)
'ソートする(comb-sort)
'参考：http://www2.moug.net/bbs/exvba/20060430000011.htm
Dim dataL As Integer
Dim dataU As Integer
Dim i As Integer
Dim gap As Integer
Dim tmp As Integer
Dim flg As Boolean
dataL = LBound(data)
dataU = UBound(data)
gap = dataU - dataL
flg = True
Do While gap > 1 Or flg
gap = Int(gap / 1.3)
Select Case gap
Case 9, 10
gap = 11
Case Is < 1
gap = 1
End Select
flg = False
For i = dataL To dataU - gap
If data(i) > data(i + gap) Then
tmp = data(i)
data(i) = data(i + gap)
data(i + gap) = tmp
flg = True
End If
Next
Loop
End Sub
*/
以上駄文失礼//
VB6.0ですが、こんな感じ？
Dim r(43) As Long
Dim Shuffle1 As Long
Dim Shuffle2 As Long
Dim hozon As Long
Dim i As Long
For i = 1 To 43
r(i) = i
Next
For i = 1 To 100
Shuffle1 = Rnd(1) * 43 + 1
Shuffle2 = Rnd(1) * 43 + 1
hozon = r(Shuffle1)
r(Shuffle1) = r(Shuffle2)
r(Shuffle2) = hozon
Next
あとはr(1)〜r(6)の６コを抜き出せばランダムになっています
別にr(1)からにこだわる必要もないですが
ソートに関しては、ListBox辺りに丸投げするとか (爆)
よく見たらガッさんの内容とほぼ同じでしたね・・・orz
ガッさん
>そうですか？
>見た目.NETっぽいので、違うかもしれませんよ？
Private Sub Button1_Click(略) Handles Button1.Click
そうみたいですね
失礼しました。
ところで、ArrayListを使ったらどうですかね。
ソートも簡単ですし。
ここにもいいソートのサンプルプログラムありましたよ。
ＶＢ６．０ではソートするメソッドってないんですね・・・
＜ＶＢ6.0＞
http://www.geocities.co.jp/SilkRoad/4511/vb/sort.htm
シャッフルする方法ではなくて、純粋に箱から選んだ数字が無くなっていく方法で作ってみました。ソートはバブルソートにしましたが、クイックソートとかの方が速いかもしれません。（そんなに変わらないと思いますが・・・
Public Class LotoX
Private NumMax As Integer 'いくつの数字までから選び出すか
Private NumSelect As Integer '選び出す個数
Private Result(0) As Integer '結果の数字を格納する配列
'プロパティーの設定
'設定のみできる
Public WriteOnly Property prpNumMax() As Integer
Set(ByVal Value As Integer)
NumMax = Value
End Set
End Property
Public WriteOnly Property prpNumSelect() As Integer
Set(ByVal Value As Integer)
NumSelect = Value
End Set
End Property
'参照のみできる
Public ReadOnly Property prpResult() As Integer()
Get
Return Result
End Get
End Property
'計算を実行する
Public Sub Execute()
'最大数や選び出す数が適切でない場合エラーとして0を返す
If NumSelect > NumMax Or NumSelect < 1 Or NumMax < 1 Then
Result(0) = 0
Exit Sub
End If
'数を選び出し結果を配列に格納する
Call SelectNum()
'結果を昇順に並べ替える
Call SortResult()
End Sub
'数を選び出し結果を配列に格納する
Private Sub SelectNum()
Dim Box() As Integer '選び出す為の数字を入れておく箱
Dim NumBoxIndex As Integer '何番目の箱から取り出すか
Dim NumBoxRest As Integer '箱の中にあと何個数字が入っているか
Dim I, J As Integer
'箱に数字を入れる
ReDim Box(NumMax - 1)
For I = 0 To NumMax - 1
Box(I) = I + 1
Next
'結果の配列を用意する
ReDim Result(NumSelect - 1)
'乱数の初期化
Randomize()
'数を選び出す
For I = 0 To NumSelect - 1
'箱の残り数を求める
NumBoxRest = NumMax - I
'何番目の箱から選ぶか決める
NumBoxIndex = Int(Rnd() * NumBoxRest)
'選んだ番号の箱から数字を結果に取り出す
Result(I) = Box(NumBoxIndex)
'箱から選んだ数字を削除する
For J = NumBoxIndex To NumBoxRest - 2
Box(J) = Box(J + 1)
Next
ReDim Preserve Box(NumBoxRest - 2)
Next
End Sub
'結果を昇順に並べ替える
Private Sub SortResult()
Dim Buff As Integer
Dim I, J As Integer
I = NumSelect - 2
Do While I >= 0
For J = 0 To I
If Result(J) > Result(J + 1) Then
Buff = Result(J)
Result(J) = Result(J + 1)
Result(J + 1) = Buff
End If
Next
I -= 1
Loop
End Sub
End Class
ついでにイベントプロシージャも載せときますね
Private Sub btnExecute_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnExecute.Click
Dim insLotoX As New LotoX()
Dim NumMax As Integer
Dim NumSelect As Integer
Dim Buff As String
Dim I As Integer
'数値が入力されているか調べる
If (Not IsNumeric(txtNumMax.Text)) Or (Not IsNumeric(txtNumSelect.Text)) Then
txtResult.Text = "数値を入力してください"
Exit Sub
End If
'少数が入力されていたら整数に変換する
NumMax = CInt(txtNumMax.Text)
NumSelect = CInt(txtNumSelect.Text)
txtNumMax.Text = CStr(NumMax)
txtNumSelect.Text = CStr(NumSelect)
'数値を設定して実行する
insLotoX.prpNumMax = NumMax
insLotoX.prpNumSelect = NumSelect
insLotoX.Execute()
'エラーの場合
If insLotoX.prpResult(0) = 0 Then
txtResult.Text = "数値が正しくありません"
Exit Sub
End If
'結果の出力
Buff = ""
For I = 0 To NumSelect - 1
Buff = Buff & insLotoX.prpResult(I) & " "
Next
txtResult.Text = Buff
End Sub
解決です。
解決です。
| ツイート |  |