下の方にあるサンプルは10年以上も前に書いたコード。 もうちっと洗練させることが出来るのではないか、と思ったので改めて書いてみた。ちゃんと動くのかな? '-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ' 機 能:重複しない乱数を発生させる ' 引 数:(i/o)NumArray … 指定範囲内の重複しない値(配列) ' (i) MaxNum … 最大値 ' (i) MinNum … 最小値(デフォルト:0) ' 返り値:取得した値の数(NumArray配列の要素数) 異常:0 '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= Public Function GetRndNum(ByRef NumArray() As Long, ByVal MaxNum As Long, _ Optional ByVal MinNum As Long = 0) As Long '引数チェック If MaxNum <= MinNum Or MinNum < 0 Then Exit Function Dim i As Long Dim RndValue As Long Dim IsUsed() As Boolean '配列再確保 ReDim NumArray(MaxNum - MinNum) As Long '返り値となる変数 ReDim IsUsed(MaxNum - MinNum) As Boolean 'その値が設定済みであることを保持する '最小値から最大値までの数値の個数(要するに返り値) GetRndNum = MaxNum - MinNum + 1 '先頭から最後まで値の設定を行う For i = 0 To UBound(NumArray) Do '乱数生成機初期化 Randomize '乱数値を取得する RndValue = Int(Rnd * GetRndNum) Loop Until (IsUsed(RndValue) = False) 'RndValueの値は使用済み IsUsed(RndValue) = True '値設定 NumArray(i) = RndValue + MinNum Next i End Function [動作確認用] Private Sub Command1_Click() Dim Data() As Long Dim DataNum As Long Dim i As Long DataNum = GetRndNum(Data, 19) For i = 0 To DataNum - 1 Debug.Print Data(i) & Space$(1); Next i Debug.Print "" End Sub
はるか昔に書いたモノ。ちゃんと動くのかな? '--------------------------------------------------------------------- ' 関数名 : CreateRandNumNotTheSame ' 機能 : 重複しない乱数を発生させる ' 引数 : (in/out) RandNumArray() … 乱数を格納する配列変数 ' (in) MaxNum … 乱数の最大値 ' (in) MinNum … 乱数の初期値(デフォルト=0) ' 戻り値 : 正常 : 発生させた乱数の個数が返る、 ' エラー: -1が返る '--------------------------------------------------------------------- Public Function CreateRandNumNotTheSame(ByRef RandNumArray() As Long, _ ByVal MaxNum As Long, _ ByVal Optional MinNum As Long = 0) As Long Dim RndMaxNum%, RndMinNum As Long '乱数の最小値、最大値 Dim RndRange As Long '発生させる乱数の幅 Dim ArrayNum As Long '配列数 Dim GotRndNum As Long '発生させた乱数 Dim i As Long 'ループ作業用変数 Dim CheckFlag() As Boolean '数字チェック用配列変数 'True …数字が存在している 'False…数字が存在していない On Error GoTo ErrHandler If MaxNum < MinNum Then GoTo ErrHandler RndRange = (MaxNum - MinNum) + 1 '発生させる乱数の幅を取得 ArrayNum = MaxNum - MinNum '配列数を取得 'メモリー確保 ReDim RandNumArray(ArrayNum) As Long ReDim CheckFlag(ArrayNum) As Boolean 'チェック変数初期化 For i = 0 To ArrayNum CheckFlag(i) = False '数字が存在していないにセット Next i '乱数発生 & 格納 For i = 0 To ArrayNum Do Randomize '乱数ジェネレータ初期化 '指定範囲内での乱数で発生させる GotRndNum = Int(Rnd * RndRange) + MinNum Loop Until CheckFlag(GotRndNum - MinNum) = False '数字が存在しているにセット CheckFlag(GotRndNum - MinNum) = True '数を格納 RandNumArray(i) = GotRndNum Next i CreateRandNumNotTheSame = ArrayNum NormalExit: Exit Function ErrHandler: CreateRandNumNotTheSame = -1 End Function [動作確認用] Private Sub Command1_Click() Dim RandNum() As Long Dim GotRndNum As Long Dim i As Long 'GotRndNum = CreateRandNumNotTheSame(RandNum(), 20, 1) 'GotRndNum = CreateRandNumNotTheSame(RandNum(), 20) GotRndNum = CreateRandNumNotTheSame(RandNum(), 20, 10) For i = 0 To GotRndNum Debug.Print RandNum(i) & ","; Next i Debug.Print "" End Sub |