円順列全パターン生成マクロの導入手順と使い方

Excelはビジネスの現場での数値計算やデータ分析に広く利用されていますが、VBAマクロを活用することでさらに高度な操作が可能となります。今回は、円順列パターンをExcelで手軽に生成できるVBAマクロの導入手順と使い方をご紹介します。

円順列パターンの使い道
円順列パターン生成マクロの導入手順
使い方
1. まとめ
参考ページ：円順列の概要と組み合わせの数を事前にチェックする

円順列パターンの使い道

円順列は、特定の点を固定してその周りの順番を変える組み合わせのことを指します。例えば商品の陳列順や、プレゼンテーションのスライドの順序など、順序を変えて最適な組み合わせを見つける際に活用できます。このマクロを使えば、手動で複数の組み合わせを試す必要がなく、効率的に最適な順番を見つけ出すことができます。

円順列の並べ方の数は(n-1)!（n-1の階乗）で計算できます。nは要素の数です。なお、階乗はFACT関数で取り扱うことができます。下記のマクロを実行する前に、存在する並べ順の数を確認するのもよいでしょう。あまりにたくさんの並べ順があると、パターン生成に時間がかかることが予想されます。詳しくはページ下部のリンクから、並べ順の数のチェックを調べる手順を確認してください。

円順列パターン生成マクロの導入手順

まず、VBAエディタを開きます。Excelの[開発]タブから[Visual Basic]をクリックしてください。または{Alt}+{F11}キーでVisual Basic Editorを起動します。
新しいモジュールを追加するために、[挿入]タブから[標準モジュール]をクリックします。
新しいモジュールウィンドウが表示されたら、下記のコードを貼り付けます。
貼り付けが完了したら、VBAエディタを閉じてExcelに戻ります。

マクロのコード

Sub GenerateCircularPermutations()

    Dim nRange As Range
    Dim OutputCell As Range
    Dim Items() As Variant
    Dim CurrRow As Long

    ' Prompt the user to select the range of items
    On Error Resume Next
    Set nRange = Application.InputBox("アイテムの範囲を選択してください:", Type:=8)
    On Error GoTo 0
    If nRange Is Nothing Then Exit Sub

    ' Prompt the user to select the starting cell for output
    On Error Resume Next
    Set OutputCell = Application.InputBox("出力先の開始セルを指定してください:", Type:=8)
    On Error GoTo 0
    If OutputCell Is Nothing Then Exit Sub

    ' Get the items
    Items = nRange.Value

    ' Set the fixed item
    Dim FixedItem As Variant
    FixedItem = Items(1, 1)

    CurrRow = OutputCell.Row

    ' Generate the circular permutations
    Call CreatePermutations(FixedItem, Items, 2, OutputCell, CurrRow)

End Sub

Sub CreatePermutations(FixedItem As Variant, ByRef Items() As Variant, ByVal StartIdx As Long, ByRef OutputCell As Range, ByRef CurrRow As Long)
    Dim i As Long, j As Long
    Dim Temp As Variant
    Dim CurrCol As Long

    ' If reached the end, output
    If StartIdx = UBound(Items) + 1 Then
        OutputCell.Worksheet.Cells(CurrRow, OutputCell.Column).Value = FixedItem
        CurrCol = OutputCell.Column + 1
        For i = 2 To UBound(Items)
            OutputCell.Worksheet.Cells(CurrRow, CurrCol).Value = Items(i, 1)
            CurrCol = CurrCol + 1
        Next i
        CurrRow = CurrRow + 1
        Exit Sub
    End If

    ' Generate permutations recursively
    For i = StartIdx To UBound(Items)
        ' Swap elements
        Temp = Items(StartIdx, 1)
        Items(StartIdx, 1) = Items(i, 1)
        Items(i, 1) = Temp

        Call CreatePermutations(FixedItem, Items, StartIdx + 1, OutputCell, CurrRow)

        ' Swap back to original order
        Temp = Items(StartIdx, 1)
        Items(StartIdx, 1) = Items(i, 1)
        Items(i, 1) = Temp
    Next i

End Sub