【Excel VBA】マトリックス形式から表形式に変換するマクロの作成方法！

2020年11月28日 2020年11月28日

どーも Takeです。

久々のブログ投稿です（さぼるにさぼってました笑）。

この記事ではマトリックス形式から表形式に変換するマクロの作成方法について簡単に解説します。

これはこのマクロが仕事で必要になったため、自分用に作りました。

もしよければ参考にしてみてください。

※ いつものようにつくったのも共有しときますので、よければどうぞ（ブック保護、シート保護はかかってます）。

マトリックス形式→表形式に変換するマクロ

マクロの作り方

マトリックス形式から表形式に変換するマクロの作り方を簡単にざっくり説明します。

正直超簡単なので、安心してください。

順にシート構成、VBAのソースコードと説明します。

シート構成

シートは下記４シートから構成されます。

main ・・・マクロのフロントシート。これは実行ボタンを置いて説明を書いただけのシートです。
setting(非表示シート) ・・・「matrix」シートの設定を記述するシートです（マクロ内で自動記載されます）。
matrix ・・・入力シート。マトリックス形式のデータを登録するシートです。
table ・・・出力シート。表形式のデータが出力されるシートです。

シートの内容について説明します。

※ mainシートは特に重要でないため省きます。

「setting」シート

「setting」シートは非表示シートのため中身が見れません。

非表示にする理由として、値をいじられたくないからです。

このシートでは「matrix」シートの設定内容が Excel 関数で取得できるようになっています。

また Excel 関数が万が一消えたことを想定して Excel マクロ内で記述するように設定しています。

Excel 関数はこんな感じのことが書かれています。

A5 セル・・・=IFERROR(MATCH("*?",INDEX(matrix!A:A&"",0),0),0)
B5 セル・・・ =IFERROR(COUNTA(matrix!A:A)+1,0)
C5 セル・・・ =IFERROR(MATCH("*?",INDEX(matrix!1:1&"",0),0),0)
D5 セル・・・ =IFERROR(COUNTA(matrix!1:1)+1,0)

要は「matrix」シートの列と行のデータのはじまりと終わりの位置情報（セルの何行目何列目か）を取得しているだけです。

「matrix」シート

「matrix」シートは入力シートです。

注意点は列名、行名が入っている箇所のみデータが出力される点です。

上記の画面では、列名行名が入力されている赤枠しかデータ出力されないので注意が必要です。

「table」シート

「table」シートは出力シートです。

「matrix」シートに登録されたデータが出力されます。

まあ、それだけです。

ソースコード

作成したマクロのVBA ソースコードは下記になります。

長そうに感じますが、そんな難しい処理はしていません。

コードの簡単な解説はソースコードの下にします。

' ##############################################
' # マトリックス形式から表形式に変更するマクロ
' ##############################################
' シート一覧
Const SHEET_MAIN As String = "main"
Const SHEET_MATRIC As String = "matrix"
Const SHEET_TABLE As String = "table"
Const SHEET_SETTING As String = "setting"
' セル情報
Const CELL_M_C_S As String = "A5"
Const CELL_M_C_E As String = "B5"
Const CELL_M_R_S As String = "C5"
Const CELL_M_R_E As String = "D5"
'メッセージ
Const MSG_ERROR01 As String = "「" & SHEET_MATRIC & "」シートに値を正しく入力してください"
Const MSG_AFTER As String = "「" & SHEET_TABLE & "」シートに出力されました！"
' メイン
Sub main()
Dim ms As Worksheet
Dim ts As Worksheet
Dim ss As Worksheet
Dim mData, mCol, mRow
Call setting(ms, ss, ts)
Call getMatrixData(mData, mCol, mRow, ms, ss)
Call setTableData(mData, mCol, mRow, ts)
Call aterSetting
End Sub
' 初期設定
Private Sub setting(ByRef ms, ByRef ss, ByRef ts)
Set ms = Worksheets(SHEET_MATRIC)
Set ts = Worksheets(SHEET_TABLE)
Set ss = Worksheets(SHEET_SETTING)
ss.Range(CELL_M_C_S) = "=IFERROR(MATCH(" & """" & "*?" & """" & ",INDEX(matrix!A:A&" & """" & """" & ",0),0),0)"
ss.Range(CELL_M_C_E).Value = "=IFERROR(COUNTA(matrix!A:A)+1,0)"
ss.Range(CELL_M_R_S).Value = "=IFERROR(MATCH(" & """" & "*?" & """" & ",INDEX(matrix!1:1&" & """" & """" & ",0),0),0)"
ss.Range(CELL_M_R_E).Value = "=IFERROR(COUNTA(matrix!1:1)+1,0)"
ts.Cells.ClearContents
End Sub
' マトリックスデータ取得
Private Sub getMatrixData(ByRef mData, ByRef mCol, ByRef mRow, ByRef ms, ByRef ss)
Dim dStartCol, dStartRow
Dim dEndCol, dEndRow
dStartCol = ss.Range(CELL_M_C_S)
dStartRow = ss.Range(CELL_M_R_S)
dEndCol = ss.Range(CELL_M_C_E)
dEndRow = ss.Range(CELL_M_R_E)
If dStartCol = 0 Or dStartRow = 0 Or dEndCol = 0 Or dEndRow = 0 Then
MsgBox MSG_ERROR01
End
End If
mRow = ms.Range(ms.Cells(1, dStartRow), ms.Cells(1, dEndRow))
mCol = ms.Range(ms.Cells(dStartCol, 1), ms.Cells(dEndCol, 1))
mData = ms.Range(ms.Cells(dStartCol, dStartRow), ms.Cells(dEndCol, dEndRow))
End Sub
' 表形式に書き込み
Private Sub setTableData(ByRef mData, ByRef mCol, ByRef mRow, ByRef ts)
Application.ScreenUpdating = False
Dim idx, x, y
y = 1
idx = 1
For Each c In mCol
x = 1
For Each r In mRow
ts.Cells(idx, 1) = c
ts.Cells(idx, 2) = r
ts.Cells(idx, 3) = mData(y, x)
idx = idx + 1
x = x + 1
Next r
y = y + 1
Next c
Application.ScreenUpdating = True
End Sub
' 後処理
Private Sub aterSetting()
Application.ScreenUpdating = False
MsgBox MSG_AFTER
Sheets(SHEET_MAIN).Select
Range("A1").Select
Sheets(SHEET_MATRIC).Select
Range("A1").Select
Sheets(SHEET_TABLE).Select
Range("A1").Select
Application.ScreenUpdating = True
End Sub

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

' ##############################################

' # マトリックス形式から表形式に変更するマクロ

' ##############################################

' シート一覧

Const SHEET_MAIN As String = "main"

Const SHEET_MATRIC As String = "matrix"

Const SHEET_TABLE As String = "table"

Const SHEET_SETTING As String = "setting"

' セル情報

Const CELL_M_C_S As String = "A5"

Const CELL_M_C_E As String = "B5"

Const CELL_M_R_S As String = "C5"

Const CELL_M_R_E As String = "D5"

'メッセージ

Const MSG_ERROR01 As String = "「" & SHEET_MATRIC & "」シートに値を正しく入力してください"

Const MSG_AFTER As String = "「" & SHEET_TABLE & "」シートに出力されました！"

' メイン

Sub main()

Dim ms As Worksheet

Dim ts As Worksheet

Dim ss As Worksheet

Dim mData, mCol, mRow

Call setting(ms, ss, ts)

Call getMatrixData(mData, mCol, mRow, ms, ss)

Call setTableData(mData, mCol, mRow, ts)

Call aterSetting

End Sub

' 初期設定

Private Sub setting(ByRef ms, ByRef ss, ByRef ts)

Set ms = Worksheets(SHEET_MATRIC)

Set ts = Worksheets(SHEET_TABLE)

Set ss = Worksheets(SHEET_SETTING)

ss.Range(CELL_M_C_S) = "=IFERROR(MATCH(" & """" & "*?" & """" & ",INDEX(matrix!A:A&" & """" & """" & ",0),0),0)"

ss.Range(CELL_M_C_E).Value = "=IFERROR(COUNTA(matrix!A:A)+1,0)"

ss.Range(CELL_M_R_S).Value = "=IFERROR(MATCH(" & """" & "*?" & """" & ",INDEX(matrix!1:1&" & """" & """" & ",0),0),0)"

ss.Range(CELL_M_R_E).Value = "=IFERROR(COUNTA(matrix!1:1)+1,0)"

ts.Cells.ClearContents

End Sub

' マトリックスデータ取得

Private Sub getMatrixData(ByRef mData, ByRef mCol, ByRef mRow, ByRef ms, ByRef ss)

Dim dStartCol, dStartRow

Dim dEndCol, dEndRow

dStartCol = ss.Range(CELL_M_C_S)

dStartRow = ss.Range(CELL_M_R_S)

dEndCol = ss.Range(CELL_M_C_E)

dEndRow = ss.Range(CELL_M_R_E)

If dStartCol = 0 Or dStartRow = 0 Or dEndCol = 0 Or dEndRow = 0 Then

MsgBox MSG_ERROR01

End

End If

mRow = ms.Range(ms.Cells(1, dStartRow), ms.Cells(1, dEndRow))

mCol = ms.Range(ms.Cells(dStartCol, 1), ms.Cells(dEndCol, 1))

mData = ms.Range(ms.Cells(dStartCol, dStartRow), ms.Cells(dEndCol, dEndRow))

End Sub

' 表形式に書き込み

Private Sub setTableData(ByRef mData, ByRef mCol, ByRef mRow, ByRef ts)

Application.ScreenUpdating = False

Dim idx, x, y

y = 1

idx = 1

For Each c In mCol

x = 1

For Each r In mRow

ts.Cells(idx, 1) = c

ts.Cells(idx, 2) = r

ts.Cells(idx, 3) = mData(y, x)

idx = idx + 1

x = x + 1

Next r

y = y + 1

Next c

Application.ScreenUpdating = True

End Sub

' 後処理

Private Sub aterSetting()

Application.ScreenUpdating = False

MsgBox MSG_AFTER

Sheets(SHEET_MAIN).Select

Range("A1").Select

Sheets(SHEET_MATRIC).Select

Range("A1").Select

Sheets(SHEET_TABLE).Select

Range("A1").Select

Application.ScreenUpdating = True

End Sub

ソースコードでは下記のような処理を順にしています。

メイン処理(main) ・・・ただのメイン処理、ここに下記関数を順に実行しています。
初期設定（setting）・・・「table」シートの初期化、シート名の設定、「setting」シートに関数を埋め込みます。
マトリックスデータ取得（getMatrixData）・・・「matrix」シートの値を取得して配列に格納しています。
表形式に書き込み（setTableData）・・・「matrix」シートの値（配列）をループ文（for Each文）で「table」シートに書き込みます。
後処理（aterSetting）・・・完了メッセージ、全シートを「A1」セルに選択してます。

これがすべてです。めちゃくちゃシンプルなやり方だと思います。

「よくわからん」と思った人もソースコードをよく見ればたぶんなんとかわかると思います（ざっくりですみません。。）

最後に

いかがでしょうか？

今回はマトリックス形式から表形式に変換するマクロの作成方法をご紹介しました。

ブログ書くの楽しいですね。またなんか作ったら投稿します。

なんか作ってほしいマクロがあれば「お問い合わせ」から問い合わせてください。

簡単そうなものならつくります。

ではでは。

2024年4月
月	火	水	木	金	土	日
1	2	3	4	5	6	7
8	9	10	11	12	13	14
15	16	17	18	19	20	21
22	23	24	25	26	27	28
29	30