VBAの配列を偏りなく高速にランダムに並べ替える

ランダムな配列の必要性

通常、配列はなんらかの規則性を持って並んでいることが多いのですが、並び順が不規則であることが必要な場合があります。データの最大や最小や昇順や降順などを無視した状態でのテストを行うような場合で、データがいくつあるか不明、最大値も不明、最小値も不明、でもそこから結果がどうなるのかを検証しなければならない、というようなことがあります。

そのような場合には規則性を持ったデータ列はむしろ邪魔で、めちゃくちゃな並び順であることの方が必要になります。手で入れ替えてもいいのですが、数が多くなれば当然大変です。

以下で配列の内容を値に関係なく偏りなくランダムに並べ替えるコードを紹介します。

処理速度はO(n)と高速に動作するフィッシャー-イェーツのシャッフルアルゴリズムを採用しています。当該アルゴリズムについての詳細は各自で。

コード

以下は配列の要素を高速にランダムに入れ替える関数です。引数には配列を渡します。

Sub SwapArray(ar)
    Dim iCount      As Long     '// 配列要素数
    Dim i           As Long     '// ループカウンタ
    Dim iRnd        As Long     '// 乱数値
    Dim s                       '// 一時保持バッファ
    Dim bObject     As Boolean  '// 引数データ型判定
    
    '// 配列要素数を取得
    iCount = UBound(ar)
    
    '// 入れ替え不要の場合は処理を抜ける
    If iCount < 1 Then
        Exit Sub
    End If
    
    '// 引数がオブジェクト型か判定
    bObject = IsObject(ar(0))
    
    '// 終端から先頭1に向かってループ
    For i = iCount To 1 Step -1
        '// 乱数値を取得（0?ループごとの終端値の範囲で取得）
        iRnd = Int((i + 1) * Rnd)
        
        '// オブジェクト配列の場合
        If bObject = True Then
            '// 配列の乱数値を終端と入れ替える
            Set s = ar(iRnd)
            Set ar(iRnd) = ar(i)
            Set ar(i) = s
        '// オブジェクト配列ではない場合
        Else
            '// 配列の乱数値を終端と入れ替える
            s = ar(iRnd)
            ar(iRnd) = ar(i)
            ar(i) = s
        End If
    Next
End Sub

Sub SwapArray(ar)

Dim iCount As Long '// 配列要素数

Dim i As Long '// ループカウンタ

Dim iRnd As Long '// 乱数値

Dim s '// 一時保持バッファ

Dim bObject As Boolean '// 引数データ型判定

'// 配列要素数を取得

iCount = UBound(ar)

'// 入れ替え不要の場合は処理を抜ける

If iCount < 1 Then

Exit Sub

End If

'// 引数がオブジェクト型か判定

bObject = IsObject(ar(0))

'// 終端から先頭1に向かってループ

For i = iCount To 1 Step -1

'// 乱数値を取得（0?ループごとの終端値の範囲で取得）

iRnd = Int((i + 1) * Rnd)

'// オブジェクト配列の場合

If bObject = True Then

'// 配列の乱数値を終端と入れ替える

Set s = ar(iRnd)

Set ar(iRnd) = ar(i)

Set ar(i) = s

'// オブジェクト配列ではない場合

Else

'// 配列の乱数値を終端と入れ替える

s = ar(iRnd)

ar(iRnd) = ar(i)

ar(i) = s

End If

End Sub

処理の開始時に引数配列の要素数を取得し、要素が１つしかない場合は入れ替える必要がないため関数を抜けます。

引数の配列のデータ型はなんでもOKにしたいので、先にデータ型を取得しています。なお、IsObject(ar)と書いてしまうと要素ではなく配列自体の型をとってVariant型と判定されて常にFalse扱いになるため、IsObject(ar(0))として配列の要素でデータ型の判定を行っています。

メインのループ部分ですが、一般的な配列ループは先頭から終端に向かいますが、逆に終端から先頭に向かってループしています。これは２つの理由があり、一つはアルゴリズムのルールに従っていることと、乱数値を取得する際の終端値をループごとに１ずつ減らす必要があるのに都合が良かったためです。

同じことを先頭から終端に向かって行うループ（逆順でのループ）でもできますが、（考えるのが面倒だったので）やりませんでした。

ループ内ではループごとに０から配列インデックスの終端値の範囲でRnd関数を使って整数値を取得し、配列のインデックスに利用します。

Rnd関数や乱数については「VBAで乱数を発生させる（Rnd、Randomize）」をご参照ください。

あとは、取得した乱数値と配列の終端インデックスの要素を入れ替えます。

使い方

上の関数の使い方です。配列作って呼び出すだけです。

String型の配列とRange型の配列を用意してそれぞれで実行します。

Sub SwapArrayTest()
    Dim arString()  As String   '// 文字列配列
    Dim arRange()   As Range    '// セル配列
    Dim i           As Long     '// ループカウンタ
    
    '// テスト用の初期値を設定
    ReDim arString(7)
    ReDim arRange(7)
    
    arString(0) = "a"
    arString(1) = "b"
    arString(2) = "c"
    arString(3) = "d"
    arString(4) = "e"
    arString(5) = "f"
    arString(6) = "g"
    arString(7) = "h"
    
    Set arRange(0) = Range("A1")
    Set arRange(1) = Range("A2")
    Set arRange(2) = Range("A3")
    Set arRange(3) = Range("A4")
    Set arRange(4) = Range("A5")
    Set arRange(5) = Range("A6")
    Set arRange(6) = Range("A7")
    Set arRange(7) = Range("A8")
    
    '// 配列要素入れ替え
    Call SwapArray(arString)
    Call SwapArray(arRange)
    
    '// 文字列配列の入れ替え結果を出力
    For i = 0 To UBound(arString)
        Debug.Print CStr(i) & " - " & arString(i)
    Next
    
    '// セル配列の入れ替え結果を出力
    For i = 0 To UBound(arRange)
        Debug.Print CStr(i) & " - " & arRange(i).Address(False, False)
    Next
End Sub

Sub SwapArrayTest()

Dim arString() As String '// 文字列配列

Dim arRange() As Range '// セル配列

Dim i As Long '// ループカウンタ

'// テスト用の初期値を設定

ReDim arString(7)

ReDim arRange(7)

arString(0) = "a"

arString(1) = "b"

arString(2) = "c"

arString(3) = "d"

arString(4) = "e"

arString(5) = "f"

arString(6) = "g"

arString(7) = "h"

Set arRange(0) = Range("A1")

Set arRange(1) = Range("A2")

Set arRange(2) = Range("A3")

Set arRange(3) = Range("A4")

Set arRange(4) = Range("A5")

Set arRange(5) = Range("A6")

Set arRange(6) = Range("A7")

Set arRange(7) = Range("A8")

'// 配列要素入れ替え

Call SwapArray(arString)

Call SwapArray(arRange)

'// 文字列配列の入れ替え結果を出力

For i = 0 To UBound(arString)

Debug.Print CStr(i) & " - " & arString(i)

'// セル配列の入れ替え結果を出力

For i = 0 To UBound(arRange)

Debug.Print CStr(i) & " - " & arRange(i).Address(False, False)

End Sub

実行結果（実行するたびに並び順は変わります）
0 – a
1 – c
2 – d
3 – e
4 – b
5 – g
6 – h
7 – f
0 – A1
1 – A6
2 – A8
3 – A7
4 – A5
5 – A4
6 – A3
7 – A2

ランダムな配列の必要性

コード

使い方

関連記事