Excelで作成したマトリクス形式の表を、データとして扱い易くなるよう、リスト形式の表に並び替える手順とそれを自動処理するマクロを検討します。
【更新】2018/01/13 値が空白やゼロのだったらリストから除外するバージョンのマクロを追加しました。
マトリクス表をデータ化したい
要は下図の左の表から右の表へ表の形式を変換したいです。
これらの表形式を何と呼んだものか、日本語の標準的な呼び名が良く分からないのですが、 左の表形式はマトリクス、集計表、クロステーブル、ピボットテーブル、多次元テーブル、横持ちデータなどの呼び名が使われているようです。
一方、上図右の表形式は、単にテーブル、リスト、一覧表、フラットデータ、縦持ちデータなどと呼ばれているようです。
この記事ではとりあえず、各々「マトリクス」と「リスト」と呼ぶようにします。
マトリクス表は、公表される統計データや、各部署の営業実績表、データ連携用コードマッピング表など、いたるところで使われています。
マトリクスは人が見る分には良くても、このままデータベースに取り込む元データ（CSVなど）としては使えず、いったんリスト形式に変換・加工する必要があります。
列ごとに配置換えするコピー＆ペーストの単純作業を地道に繰り返せばいいのですが、データ量によっては非人道的な作業になります。
手作業でマトリクス表をリスト表に変換するには
マトリクス-リスト変換は古くからある問題のようで、Web を検索してみると様々な方法があるようです。
ここではその中のひとつ、「ピボットテーブル/ピボットグラフ ウィザード」というコマンドを使った手順を検証します。
「ピボットテーブル/ピボットグラフ ウィザード」コマンドは、標準のリボンには置かれていないので（Excel 2013）、コマンドボタンをクイックツールバーなどに登録するか、旧アクセスキー「Alt ⇒ D ⇒ P(Data Pivot)」で直接呼び出します。
【手順例】
- ピボットテーブルウィーザードのダイアログを開きます
- キー操作：
Alt⇒D⇒P
- キー操作：
- 最初の画面(1/3)
- 「分析するデータのある場所」に、「複数のワークシート範囲」を選択します
- 「次へ」ボタンを押します
- 次の画面（2a/3）
- 「ページフィールドの作成方法」に、「指定]」選択します
- 「次へ」ボタンを押します
- 次の画面（2b/3)
- 「結合するワークシートの範囲」でマトリクスの範囲（見出しを含む）を指定します
- 「追加」ボタンを押します
- 指定範囲が「範囲一覧」に追加表示されます
- 「次へ」ボタンを押します
- 次の画面（3/3）
- 「ピボットテーブルレポートの作成先」に、「新規ワークシート」を選択します
- 「完了」ボタンを押します
- ワークシートが新規追加されます
- ピボットテーブルに変換されています
- ピボットテーブルに変換されています
- 作成された表の一番右下のセルを「ダブルクリック」します
- ワークシートが新規追加されます
- 変換されたリスト表が作成されています
- 変換されたリスト表が作成されています
ちょっとした魔法のようですが（ウィザードだけに）、何をやっているのかサッパリ分かりません。
個人的にもこれまで何回もやった事があるのですが、全然覚えられないので毎回調べ直していました。 この機会に手順を詳細に記録しておきました。
現実のデータでは、見出しが複数階層になったマトリクス表がよくあるのですが、この方法でそこまでは対応できないようです
マトリクスデータをリストに変換するマクロ
ピボットテーブルウィザードを使った手順では行見出しと列見出しが1階層である2次元のマトリクスしか対応できません。
ここでは、複数の見出しが階層的にグルーピングされた（多次元）マトリクス表も、リストに変換するマクロを考えます。
本マクロでは、マトリクス表のセル範囲とその見出しの位置を指定するため、 選択されたセル範囲の左上隅のセルの位置をデータ領域の最初のデータとみなし、 これを基準としてマトリクス表の構造を自動判断することにします。
セルを一つ選択すると、それが基準セルとなり、それを含むアクティブセル領域（空行と空列で囲まれる領域）を見出しを含むマトリクス表の範囲として使用します。
マトリクス表の範囲のうち、基準セルより上の行と左の列を見出しデータとみなします。
それ以外の、基準セル以降右下の領域を値データと見なします。
また、基準セルは１セルだけではなく、特定の領域をセル範囲で指定することもできます。
たとえば集計行を除外したい場合など、特定のセル範囲を明示的にデータ領域としたい場合は、その範囲を選択後（見出しは含めない）、このマクロを実行します。
Option Explicit Sub マトリクスをリストに変換する() Dim table As Range Dim matrix As Range Dim target As Range If Selection.Cells.Count > 1 Then Set matrix = Selection.Cells Set table = Range(matrix.CurrentRegion.Cells(1, 1), matrix.Cells(matrix.Rows.Count, matrix.Columns.Count)) Else Set table = ActiveCell.CurrentRegion Set matrix = Range(ActiveCell, table.Cells(table.Rows.Count, table.Columns.Count)) matrix.Select End If If table.Row = matrix.Row Or table.Column = matrix.Column Then Beep Exit Sub End If Application.ScreenUpdating = False Application.EnableEvents = False Set target = ActiveWorkbook.Worksheets.Add.Range("A1") matrixToList table, matrix, target Application.EnableEvents = True Application.ScreenUpdating = True End Sub Private Sub matrixToList(srcTable As Range, srcMatrix As Range, dstList As Range) Dim rowHSize As Integer Dim colHSize As Integer Dim lineSize As Integer rowHSize = srcMatrix.Column - srcTable.Column colHSize = srcMatrix.Row - srcTable.Row lineSize = srcMatrix.Columns.Count Dim srcRowHeader As Range Dim srcColHeader As Range With srcMatrix Set srcRowHeader = .Offset(0, -rowHSize).Resize(, rowHSize) Set srcColHeader = .Offset(-colHSize, 0).Resize(colHSize) End With Dim dstKey1 As Range Dim dstKey2 As Range Dim dstVals As Range With dstList.Cells(1, 1) Set dstKey1 = .Offset(0, 0).Resize(lineSize, rowHSize) Set dstKey2 = .Offset(0, rowHSize).Resize(lineSize, colHSize) Set dstVals = .Offset(0, rowHSize + colHSize).Resize(lineSize, 1) End With Dim srcKey2Arr As Variant srcKey2Arr = WorksheetFunction.Transpose(srcColHeader.Value) Dim srcLine As Range For Each srcLine In srcMatrix.Rows dstKey1.Value = srcRowHeader.Rows(1).Value dstKey2.Value = srcKey2Arr dstVals.Value = WorksheetFunction.Transpose(srcLine.Value) Set dstKey1 = dstKey1.Offset(lineSize, 0) Set dstKey2 = dstKey2.Offset(lineSize, 0) Set dstVals = dstVals.Offset(lineSize, 0) Set srcRowHeader = srcRowHeader.Offset(1, 0) Next fillDownBlanks Range(dstList.Cells(1, 1), dstKey2.Rows(1).Offset(-1, 0)) End Sub Private Sub fillDownBlanks(rng As Range) Dim blanks As Range If rng.Cells.Count > 1 Then On Error Resume Next For Each blanks In rng.SpecialCells(xlCellTypeBlanks).Areas If blanks.Row > 1 Then blanks.Value = blanks.Rows(1).Offset(-1, 0).Value End If Next On Error GoTo 0 End If End Sub
【使い方】
- 標準モジュールに上記 VBA プログラムをコピー＆ペーストします
- マトリクス表のデータ領域、あるいはその左上隅のセルを選択します
- マクロを実行します
- 新規シートにテーブル形式の表が出力されます
見出しに、階層を表す空欄があったりセル結合されていても自動で補完します。
複数行・列の見出しも展開したい場合には、表全体ではなく、実データ範囲の最初（左上）のセルのみを選択します。見出しの内容によっては期待通りにならないかもしれません。
パフォーマンスを優先するために書式を捨てているので、数値などでは元データと表示が異なることがあり、日付など数値になってしまいますので注意してください。
【注意】 本マクロの動作は期待する結果の確実性・正確性を保証するものではありません。変換結果のデータはよくご確認ください。
追加：空白とゼロはいらない
ご要望がありましたので、セル値が空白やゼロのデータだった場合にリストに含めないようにする機能を拡張する変換マクロを追加しました。
下記マクロ VBA を追加で元のマクロの下にコピー＆ペーストしてください。
使い方は元のマクロと一緒です。 ３つマクロがありますが機能の違いはマクロ名の通りです。
Sub マトリクスをリストに変換する_空白なし() Call マトリクスをリストに変換する Application.ScreenUpdating = False deleteRowsByValue "" Application.ScreenUpdating = True End Sub Sub マトリクスをリストに変換する_ゼロなし() Call マトリクスをリストに変換する Application.ScreenUpdating = False deleteRowsByValue "0" Application.ScreenUpdating = True End Sub Sub マトリクスをリストに変換する_空白とゼロなし() Call マトリクスをリストに変換する Application.ScreenUpdating = False deleteRowsByValue "", "0" Application.ScreenUpdating = True End Sub Private Sub deleteRowsByValue(ParamArray vals() As Variant) Range("A1").EntireRow.Insert Range("A1").Value = "a" With ActiveSheet.UsedRange .AutoFilter Field:=.Columns.Count, Criteria1:=CVar(vals), Operator:=xlFilterValues .EntireRow.Delete End With End Sub
【注意】 あくまで暫定的な実装ということであまりテストしていませんので、実行は注意して結果をよく確認してください。
特にもとの VBA プログラムをカスタマイズして既存シートにリストを展開させるなどしている方はこれを絶対に使わないでください。展開先の既存シートを盛大に壊します。
まとめ
マトリクスからリストへの変換はまま発生する業務なのですが、非常に苦痛な作業です。
ピボットテーブルウィザードによる逆ピボットで擬似的にマトリクスをリストに変換する手順を紹介しました。
逆ピボットでできることは現実データからみれば限られています。 できればマクロなど不要になる、 Excel の機能として対応されることを望みたいところです。
本記事の内容は Windows 10 の Excel 2013 で動作確認しました。
