乱数発生に重ならないようにしたら処理時間がかなりかかる。
解決Private Sub Command4_Click()
Dim a1 As Integer
Dim a2 As Integer
Dim a3 As Integer
Dim a4 As Integer
Dim a5 As Integer
Dim a6 As Integer
Dim a7 As Integer
Dim a8 As Integer
Dim a9 As Integer
Dim a10 As Integer
Do Until a1 <> a2 And a1 <> a3 And a1 <> a4 And a1 <> a5 And a1 <> a6 And a1 <> a7 And a1 <> a8 And a1 <> a9 And a1 <> a10 And _
a2 <> a3 And a2 <> a4 And a2 <> a5 And a2 <> a6 And a2 <> a7 And a2 <> a8 And a2 <> a9 And a2 <> a10 And _
a3 <> a4 And a3 <> a5 And a3 <> a6 And a3 <> a7 And a3 <> a8 And a3 <> a9 And a3 <> a10 And _
a4 <> a5 And a4 <> a6 And a4 <> a7 And a4 <> a8 And a4 <> a9 And a4 <> a10 And _
a5 <> a6 And a5 <> a7 And a5 <> a8 And a5 <> a9 And a5 <> a10 And _
a6 <> a7 And a6 <> a8 And a6 <> a9 And a6 <> a10 And _
a7 <> a8 And a7 <> a9 And a7 <> a10 And _
a8 <> a9 And a8 <> a10 And _
a9 <> a10
a1 = Int(Rnd * 10) + 1
a2 = Int(Rnd * 10) + 1
a3 = Int(Rnd * 10) + 1
a4 = Int(Rnd * 10) + 1
a5 = Int(Rnd * 10) + 1
a6 = Int(Rnd * 10) + 1
a7 = Int(Rnd * 10) + 1
a8 = Int(Rnd * 10) + 1
a9 = Int(Rnd * 10) + 1
a10 = Int(Rnd * 10) + 1
Text1.Text = a1
Text2.Text = a2
Text3.Text = a3
Text4.Text = a4
Text5.Text = a5
Text6.Text = a6
Text7.Text = a7
Text8.Text = a8
Text9.Text = a9
Text10.Text = a10
Loop
end sub
乱数を１から10まで重ならないようにできたものの、いちいち比較しないとだめなんで、処理時間がかなりかかります。どうすれば、簡単に早く、乱数を
重ならないように発生できるんですか、ご指導よろしくお願いします。
安定した時間で１から１０の値がほしいのであれば、
値をシャッフルする事で取得できます。
シャッフル回数を変更することで、バラツキ率が変更
できます。
Private Sub Command1_Click()
Dim I As Integer
Dim iData(0 To 9) As Integer
Dim iIndex1 As Integer
Dim iIndex2 As Integer
Dim iDataBack As Integer
' 1 〜 10までの連続した数値を用意する
For I = 0 To 9
iData(I) = I + 1
Next I
' 値をシャッフルする
For I = 1 To 10
iIndex1 = Int(Rnd * 10)
iIndex2 = Int(Rnd * 10)
iDataBack = iData(iIndex1)
iData(iIndex1) = iData(iIndex2)
iData(iIndex2) = iDataBack
Next I
' 数値を表示する
Text1.Text = CStr(iData(0))
Text2.Text = CStr(iData(1))
Text3.Text = CStr(iData(2))
Text4.Text = CStr(iData(3))
Text5.Text = CStr(iData(4))
Text6.Text = CStr(iData(5))
Text7.Text = CStr(iData(6))
Text8.Text = CStr(iData(7))
Text9.Text = CStr(iData(8))
Text10.Text = CStr(iData(9))
End Sub
通りすがりですが。
コレってビンゴや分割パズルに使うヤツですよね。
全部使わなかったり、母数が多い場合はこういうのもアリか？・・・と。
Option Explicit
Private Bufs() As Integer
Private MaxNums As Integer
Private Sub Command1_Click()
Dim i As Integer
Randomize
List1.Clear
Call Rinit(10) '引数に必要な乱数の個数セットして初期化しる
For i = 1 To 10
List1.AddItem Rget() 'コレを必要なだけ呼び出します、（呼びすぎ注意）
Next i
End Sub
'バッファの確保とテーブルの作成
Private Sub Rinit(X As Integer)
Dim i As Integer
ReDim Bufs(X)
MaxNums = X
For i = 1 To X
Bufs(i) = i
Next i
End Sub
'くじ引き的抽選
'残っているテーブル番号をランダムに選び、数値を抜き取る
'取ったあとはテーブルの最後の数値に書き換えて、テーブル数を減らします（同じ数値は出ません）
'正規分布はしないけど、ゲームに使うならってことで
'（バレルシフトすればソートしたのと同じになりますけどね）
Private Function Rget() As Integer
Dim Ptr As Integer
Ptr = Int(Rnd() * MaxNums) + 1
Rget = Bufs(Ptr)
Bufs(Ptr) = Bufs(MaxNums)
If MaxNums > 1 Then
MaxNums = MaxNums - 1
End If
End Function
ありがとうございました。uchiさん、ファン太さん！おかげさまでできました。
| ツイート |  |