スポンサーリンク

【VBA】重複のない乱数を作成するマクロを4つ紹介します!

VBAでの操作

こんにちは。blueです。

今回は重複のない」「乱数」を作成するマクロを紹介します。

発端は以下のビンゴカードです。

元ネタは@BimoriCさんで、Excelだけでビンゴができるようにされています。
音も出るようにされてますし、会社でやれば盛り上がること間違いなしです。

その中で今回は「1~99の中から重複のない乱数を取得する」方法を勉強しましたので、内容を含め紹介します。

これを使えるようになると誰でもちょっとしたゲームを作れるようになります。

スポンサーリンク

乱数の作成方法

まずExcel VBAでの乱数の作成方法についてですが主に以下の2つになります。

  • VBAのRnd関数
  • ExcelのRandBetween関数

Rnd関数は0 以上 1 未満の値を返します。

一方RandBetween関数は指定された範囲内の整数を返します。

コードはそれぞれ以下のようになります。

Public Sub random()
'Rnd関数を使ったコード(Randomizeなし)

    Dim ws As Worksheet
    Dim rngCard As Range
    Dim i As Long

    'Randomize

    Const adress As String = "B3:F7" 'BINGOカードの対象範囲
    
    Set ws = ThisWorkbook.Worksheets(1)
    
    Set rngCard = ws.Range(adress)
    
    For i = 1 To rngCard.Count
        rngCard(i).Value = Int(Rnd * 100) + 1
    Next

End Sub
Public Sub random2()
'ExcelのRandBetween関数を使ったコード

    Dim ws As Worksheet
    Dim rngCard As Range
    Dim i As Long
    
    Const adress As String = "B3:F7" 'BINGOカードの対象範囲
    
    Set ws = ThisWorkbook.Worksheets(1)
    
    Set rngCard = ws.Range(adress)
    
    For i = 1 To rngCard.Count
        rngCard(i).Value = WorksheetFunction.RandBetween(1, 99)
    Next

End Sub

今回は整数を取得しますので、Rnd関数を使う場合はInt(Rnd*100)で1~99の整数を取得することができます。

しかしこのRnd関数には疑似乱数という問題があります。

乱数とはいっても決まった配列(乱数の種)が存在していて毎回同じ配列になってしまうのです。

詳しくはこちらが参考になると思います

具体的には以下のように初回起動時には毎回同じ数字が出るようになります。

これだと毎回同じカードしかできますし、ビンゴをする際のボールも毎回同じものが出てきてしまいます。

それを解消するものとしてRandomizeステートメントいうものが存在します。

これをコードの初めに記載することで毎回異なる乱数を取得できるようになります。

一方RandBetweenに関してはそういった現象は起こりません。
その為そのまま使ってもらって問題ありません。

重複のない乱数作成マクロ4選

ここからは重複のない乱数作成マクロを紹介しますが手法としては以下の2つがあります。

  • 重複しない乱数を取得する
  • 連番から乱数を取得する

それぞれについて2つずつ紹介します。

1 重複しない乱数を取得する(配列使用)

コードは以下です。

Public Sub random3()
'重複しない乱数を作るコード(配列使用)
    
    Dim num(24) As Long
    Dim i As Long
    Dim buf As Long
    Dim ws As Worksheet
    Dim rngCard As Range
    Dim j As Long
    Dim k As Long
    
    Const adress As String = "B3:F7" 'BINGOカードの対象範囲
    
    i = 0
    Do Until i > 24
        buf = WorksheetFunction.RandBetween(1, 99)
        If Not ExistsNumber(buf, num) Then
            num(i) = buf
            i = i + 1
        End If
    Loop
    
    Set ws = ThisWorkbook.Worksheets(1)
    
    Set rngCard = ws.Range(adress)
    
    j = 0
    For k = 1 To rngCard.Count
    rngCard(k).Value = num(j)
        j = j + 1
    Next
End Sub

Private Function ExistsNumber(buf As Long, num() As Long) As Boolean
    
    Dim i As Long
    
    For i = 0 To 24
        If buf = num(i) Then
            ExistsNumber = True
            Exit For
        End If
    Next
    
    ExistsNumber = False
    
End Function

詳細は以下になります。

Dim num(24) As Long

 まず乱数を格納する配列を用意します。今回は5*5なので0から24の25個を用意します。

buf = WorksheetFunction.RandBetween(1, 99)

 RandBetween関数で1~99内の数字を取得します。

If Not ExistsNumber(buf, num) Then

 その数字が配列内に存在するかを確認します。

関数は下のFunctionプロシージャ内にあり、数字が配列内にあればTrueを、なければFalseを返すようにしています。

もし戻り値がFalseであれば配列に格納するようにしています。

これを25回繰り返して重複のない乱数を取得しています。

rngCard(k).Value = num(j)

 最後に格納した配列の要素をビンゴカードに出力します。

2 重複しない乱数を取得する(Dictionary使用)

コードは以下です。

Public Sub random4()
'重複しない乱数を作るコード(Dictionary)
    
    Dim dic As Dictionary
    Dim i As Long
    Dim buf As Long
    Dim ws As Worksheet
    Dim rngCard As Range
    Dim j As Long
    Dim k As Long
    
    Const adress As String = "B3:F7" 'BINGOカードの対象範囲
    
    Set dic = New Dictionary
    
    i = 0
    Do Until i > 24
        buf = WorksheetFunction.RandBetween(1, 99)
        If Not dic.Exists(buf) Then
            dic.Add buf, i
            i = i + 1
        End If
    Loop
    
    Set ws = ThisWorkbook.Worksheets(1)
    
    Set rngCard = ws.Range(adress)
    
    j = 0
    For k = 1 To rngCard.Count
        rngCard(k).Value = dic.Keys(j)
        j = j + 1
    Next
    
End Sub

詳細は以下になります。

Dim dic As Dictionary
Set dic = New Dictionary

 ここでは乱数を格納する場所をDictionaryオブジェクトとして取得します。

Dictionaryは配列と同じようにデータの集合を取り扱うことができます。

ただ配列と異なりIndexの部分が重複のないKeyとなります。その為重複を除去したリストを作成したいときなどに役に立ちます。

Dictionaryオブジェクトの取得方法については以下がとても参考になると思います。

buf = WorksheetFunction.RandBetween(1, 99)

 先ほどと同様にRandBetween関数で1~99内の数字を取得します。

If Not dic.Exists(buf) Then

 Dictionaryオブジェクトの大きな特徴としてExistsメソッドがあります。

dic.Exists(Key)でDictionary内のKeyが重複していないかを確認することができます。

dic.Add buf, i

 もし、数字が重複していなければ数字をKeyとして格納します。

rngCard(k).Value = dic.Keys(j)

 最後にDictonaryの各Keyをビンゴカードに出力します。

3 連番から乱数を取得する(Collection使用)

以降は連番に対してシャッフルして抜き出す手法になります。

1つ目はフィッシャーイエーツ、2つ目はダステンフェルドという方法になります。

各々については以下のサイトにわかりやすく書かれています。

1つ目は@toshi81350036さんのTweetになります。

フィッシャーイエーツは連番の入ったカードの中から一つを抜き出す操作になります。
コードは以下です。

Public Sub random5()
'連番からランダムに抜き出すコード(Collection) フィッシャーイェーツ
    
    Dim cll As Collection
    Dim i As Long
    Dim ws As Worksheet
    Dim rngCard As Range
    Dim j As Long
    Dim n As Long 'CollectionのIndex
    
    Const adress As String = "B3:F7" 'BINGOカードの対象範囲
    
    Set cll = New Collection
    For i = 1 To 99
        cll.Add i
    Next i
    
    Set ws = ThisWorkbook.Worksheets(1)
    
    Set rngCard = ws.Range(adress)
    
    For j = 1 To rngCard.Count
        n = WorksheetFunction.RandBetween(1, cll.Count)
        rngCard(j).Value = cll(n)
        cll.Remove n
    Next
    
End Sub

詳細は以下になります。

Dim cll As Collection
Set cll = New Collection

 ここでは連番を格納する場所をCollectionオブジェクトとして取得します。

Collectionオブジェクトは配列と同じようにデータの集合を取り扱うことができます。

ただ配列と異なりAddメソッドやRemoveメソッドで容易に要素の追加、削除ができます。

その為途中の要素を抜き取る今回のケースで取り扱いがしやすいという特徴があります。

For i = 1 To 99
cll.Add i
Next i

 Collectionオブジェクト内に1~99を格納します。

Collectionオブジェクトに対してはAddメソッドで要素を追加することができます。

コレクションも配列の1つなので同様にIndexを持っています。

n = WorksheetFunction.RandBetween(1, cll.Count)

 RandBetween関数で数字を取得します。ここでMaxをCollectionオブジェクトのCountとしているのがポイントです。

rngCard(j).Value = cll(n)

 取得した数値=インデックス番号に対して要素をビンゴカードに出力します。

cll.Remove n

 抜き出した数字=インデックス番号を削除します。

このようにして抜き出した数値を削除していくことで重複のない乱数を実現しています。

4 連番から乱数を取得する(配列使用)

2つ目は@blacklist_ryuさんのTweetになります。

上のコードはダステンフェルド(に近い)方法で、最大の要素から取得した数字と入れ替えていく手法になります。

コードは以下です。

Public Sub random6()
'連番をシャッフルするコード(配列) ダステンフェルド

    Dim i As Long
    Dim j As Long
    Dim RandomNumber As Long
    Dim st As Long
    Dim arr() As Long
    Dim ws As Worksheet
    Dim rngCard As Range
    Dim k As Long
    
    Const adress As String = "B3:F7" 'BINGOカードの対象範囲
    
    Randomize
    ReDim arr(1 To 99)
    
    For i = 1 To 99
        arr(i) = i
    Next
    
    For j = 99 To 1 Step -1
        RandomNumber = Int(j * Rnd) + 1
        st = arr(j)
        arr(j) = arr(RandomNumber)
        arr(RandomNumber) = st
    Next
    
    Set ws = ThisWorkbook.Worksheets(1)
    
    Set rngCard = ws.Range(adress)
    
    j = 1
    For k = 1 To rngCard.Count
        rngCard(k).Value = arr(j)
        j = j + 1
    Next
End Sub

詳細は以下になります。
For i = 1 To 99
~Next

 1~99までの数字を配列に格納します。

For j = 99 To 1 Step -1~~Next

 99番の配列と、乱数で取得した(RandomNumber)番の配列を入れ替えます。

ここでは2つの変数のデータを入れ替えるアルゴリズムを使っており、入れ替え用のストック変数を使うことで入れ替えを可能にしています。

これを減少させながら実行していくのがダステンフェルドになります。

まとめ

VBAでの乱数の取得方法はVBAのRnd関数とExcelのRandBetween関数の2種類あることがわかりました。

また重複のない乱数の取得方法としては

  • 重複しない乱数を取得する
  • 連番から乱数を取得する

方法があることがわかりました。

乱数を自在に作れるようになればゲームなども作れるようになると思います。

私も@BimoriCさんのビンゴマクロを真似て作ってみたので力試しにぜひトライしてください!

もしVBAの資格について興味を持たれた方はこちらもどうぞ

変数の命名で悩まれている方はこちらの記事も参考になります。日本語で記載すると英語に変換してくれるので、英語名で書かれている方にとってはとても便利なサイトです。

コメント

タイトルとURLをコピーしました