RandArray関数っぽいユーザー定義関数で、重複不可の引数を追加

昨日は、RandArray関数っぽく振舞う、ユーザー定義関数を作ってみた。
infoment.hatenablog.com

これの使い処を考えるうち、思いついた。少し手を加えれば、ランダムな並び替えに使用できるのでは？ということで、やってみた。

ランダム並び替えといっても、実はたいしたことをしていない。
単に、ランダムな整数の重複を禁止しただけ。結果が、ランダムに並べ替えたように見えるだけだったりする。

Function DemiRandArray(r_max As Long, _
                       c_max As Long, _
                       dra_min As Long, _
                       dra_max As Long, _
                       integer_flag As Boolean, _
              Optional duplicate_flag As Boolean = False) As Variant

    ' duplicate_flagがTrueの場合、整数に限り値の重複を不可とする。
    
    ' ランダムに作成した値を格納するための配列。
    Dim arr() As Variant
    ReDim arr(1 To r_max, 1 To c_max)
    
    ' ループ変数：行。
    Dim r As Long
    ' ループ変数：列。
    Dim c As Long
    ' 重複不可の場合に使用する辞書。
    Dim Dict As Object
    Set Dict = CreateObject("Scripting.Dictionary")
    
    ' ランダムに作成した値を一旦格納するための変数。
    Dim temp As Double
        For r = 1 To r_max
            For c = 1 To c_max
                ' Trueの場合、整数のみとする。
                Select Case integer_flag
                    Case True
                        ' Trueの場合、重複不可とする。
                        Select Case duplicate_flag
                            Case True
                                Do
                                    temp = WorksheetFunction.RandBetween(dra_min, dra_max)
                                    If Dict.Exists(temp) = False Then
                                        arr(r, c) = temp
                                        ' キー情報の重複を確認したいだけなので、アイテム不問。
                                        ' なんでもよいので、今回は「1」とした。
                                        Dict(temp) = 1
                                        Exit Do
                                    End If
                                Loop
                            Case False
                                arr(r, c) = WorksheetFunction.RandBetween(dra_min, dra_max)
                        End Select
                    Case False
                        Dim myFlag As Boolean
                            myFlag = False
                        Do While myFlag = False
                            temp = Rnd * (dra_max + 1)
                            If dra_min <= temp And temp <= dra_max Then
                                arr(r, c) = temp
                                myFlag = True
                            End If
                        Loop
                End Select
            Next
        Next
                
        DemiRandArray = arr
End Function

それでは、１～７５までの数字を縦に並べてみよう。
まずは、重複可の場合。

Sub Test()
    Dim arr As Variant
        arr = DemiRandArray(75, 1, 1, 75, True)
        Range("A2").Resize(75) = arr
End Sub

ピボットテーブルで集計してみると、欠番が生じていることが分かる。

次いで、重複不可の場合。

Sub Test()
    Dim arr As Variant
        arr = DemiRandArray(75, 1, 1, 75, True, True)
        Range("A2").Resize(75) = arr
End Sub

１～７５までの数が、全て一つずつ生成されている。

どうやら、上手くいったようだ。

では、これで何をするかというと・・・ビンゴゲームかな。

参考まで。