VBA エクセルで水準表を作成する

　水準表の作成ツールが、ググっても出てこないためExcelVBAのコードを公開します。
　下図は本プログラム実行するための入力フォーマット「入力シート」です。まず、作業①因子名をB列4行目以降に入力します。数はいくらでも構いません。次に、作業②各因子の評価水準をC列から右へ入力します。こちらも数はいくらでも構いません。また、各因子の水準数は同じでなくともよいです。最後に作業③ボタンを押します。このマクロボタンの作成方法についてはググれば出てくるような内容のため、ここでは触れません。

すると、下図のように「出力シート_水準表」に、水準表を出力する仕様です。例では、3×4×2×3＝72水準できました。

　本プログラムを下記に示します。main関数が最下部にあって、それより上のコードは各タスクの関数群である。本プログラムはmain関数を実行することで、main関数内のcallで各関数を呼び出し実行する仕組みである。なので、マクロ登録する場合は「main」を指定すれば良いです。

Public myColumn, myStartRow, myEndRow As Integer
Public 因子数, 合計水準数, 各水準数() As Integer
Public 因子名() As String
Public m As Integer
Public n As Integer
'---------------------------------------------------------------------
Sub データ数の取得()
    Dim i, j As Integer
    Dim 各水準 As Integer
    
    Worksheets("入力シート").Activate
    
    '入力されてる因子行のデータを調べて、因子数を取得
    myColumn = 2
    myStartRow = Cells(1, myColumn).End(xlDown).Row
    myEndRow = Cells(Rows.Count, myColumn).End(xlUp).Row
    因子数 = myEndRow - myStartRow + 1
    
    '各因子に入力されてる水準数(列数)を調べて、配列へ格納
    myMaxColumn = 1
    For i = 1 To 因子数
        ReDim Preserve 各水準数(i)
        myEndColumn = Cells(myStartRow - 1 + i, Columns.Count).End(xlToLeft).Column
        水準数 = myEndColumn - myColumn
        各水準数(i) = 水準数
    Next i
    
    '水準数の合計を計算する。また、因子名を配列へ格納
    合計水準数 = 1
    For j = 1 To 因子数
        合計水準数 = 合計水準数 * 各水準数(j)
        ReDim Preserve 因子名(j)
        因子名(j) = Cells(myStartRow - 1 + j, myColumn)
    Next j
End Sub
'---------------------------------------------------------------------
Sub 水準表の作成()
    Dim p, q As Integer

    '因子名を列入力
    Cells(m, n) = "水準No"
    For q = 1 To 因子数
        Cells(m, n + q) = 因子名(q)
    Next q
    
    '水準番号を行入力
    For p = 1 To 合計水準数
        Cells(m + p, n) = p
    Next p
End Sub
'---------------------------------------------------------------------
Sub データの入力()
    Dim a, b, c, d, e, f As Integer
    Dim myData() As Double
    Dim mySplit, mySplit_N As Integer
    Dim myFlag() As Integer
    
    For a = 1 To 因子数
        
        'データの抽出
        Worksheets("入力シート").Select
        If a = 1 Then
            mySplit = 各水準数(a)
        Else
            mySplit = mySplit * 各水準数(a)
        End If
        
        For b = 1 To 各水準数(a)
            ReDim Preserve myData(b)
            myData(b) = Cells(myStartRow - 1 + a, myColumn + b)
            mySplit_N = 合計水準数 / mySplit
            ReDim Preserve myFlag(b)
            myFlag(b) = mySplit_N * b
        Next b
        
        'データの入力
        Worksheets("出力シート_水準表").Select
        d = 1
        e = 1
        f = 1
        For c = 1 To 合計水準数
            If mySplit_N < e Then
                d = d + 1
                e = 1
                f = f + 1
            End If
            If b = d Then
                d = 1
                f = 1
            End If
            
            Cells(m + c, n + a) = myData(d)
            
            If myFlag(f) < c Then
                f = 1
            End If
            e = e + 1
        Next c
        Erase myData()
        Erase myFlag()
    Next a
End Sub
'---------------------------------------------------------------------
Sub シートを空にする()
    ActiveSheet.UsedRange.ClearContents
End Sub
'---------------------------------------------------------------------
Sub セルの選択()
    Range(Cells(1, 1), Range("A1").SpecialCells(xlLastCell)).Select
End Sub
'---------------------------------------------------------------------
Sub main()
    Call データ数の取得
    
    Worksheets("出力シート_水準表").Select
    Call シートを空にする
    
    m = 1   '入力開始行
    n = 1   '入力開始列
    Call 水準表の作成
    Call データの入力
    
    Worksheets("出力シート_水準表").Activate
    Call セルの選択
End Sub

●下記リンク先はpythonを使用して乱数により水準表を作成します

hk29.hatenablog.jp

以上

<広告>

リンク