【Excel】マトリクス表→リストに変更

マトリクス表

上のようなマトリクス表を、下のようなリストに変更したい場合の覚書。

リスト

1.Power Queryを使用する

①「データ」タブを選択
②「テーブルまたは範囲から」を選択

③「テーブルの作成」Boxが出てくるので、範囲を確認（一応）したうえで　 　　   「OK」

④Power Queryエディターが開く

⑤表の列項目として残したい部分（今回の場合だと「機種」）を左クリックで選択し、右クリック
⑥「その他の列のピボット解除」を選択

⑦Power Queryエディターでリスト型に変形される
⑧「閉じて読み込む」を選択

⑨リストの完成！！

2.エクセルマクロを使用する(VBAコードを書く)

2.1　コード例1

Sub Sample1()
    
Dim ws1 As Worksheet
Set ws1 = Worksheets("マトリクス")
Dim ws2 As Worksheet
Set ws2 = Worksheets("リスト")
    
'入力シートの行列(iRow：行, iCol：列)
Dim iRow As Long, iCol As Long
    
'入力シートの最大行列(rMax：行, cMax：列)
Dim rMax As Long, cMax As Long
    
'表の最終行取得（2列目）
rMax = ws1.Cells(ws1.Rows.Count, 2).End(xlUp).Row
    
'表の最終列取得（2行目）
cMax = ws1.Cells(2, ws1.Columns.Count).End(xlToLeft).Column

'出力シートの行
Dim i As Long
i = 1

'入力シートの2行目から最終行まで繰り返し
For iRow = 2 To rMax
    '入力シート2列目から最終列まで繰り返し
    For iCol = 2 To cMax

            '出力シートの1行目→入力シートの1列目（機種）
            ws2.Cells(i, 1).Value = ws1.Cells(iRow, 1).Value
            
            '出力シートの2行目→入力シートの1行目（日付）
            ws2.Cells(i, 2).Value = ws1.Cells(1, iCol).Value
            
            '出力シートの3行目→入力シートの指定の行列がぶつかるところ
            ws2.Cells(i, 3).Value = ws1.Cells(iRow, iCol).Value
            i = i + 1

    Next
Next
End Sub

2.2　コード例2（絞りたい月日がある場合）

Sub Sample2()
'月日を絞りたい場合

Dim ws1 As Worksheet
Set ws1 = Worksheets("マトリクス")
Dim ws2 As Worksheet
Set ws2 = Worksheets("リスト")
    
'入力シートの行列(iRow：行, iCol：列)
Dim iRow As Long, iCol As Long
    
'入力シートの最大行列(rMax：行, cMax：列)
Dim rMax As Long, cMax As Long
    
'表の最終行取得（2列目）
rMax = ws1.Cells(ws1.Rows.Count, 2).End(xlUp).Row
    
'表の最終列取得（2行目）
cMax = ws1.Cells(2, ws1.Columns.Count).End(xlToLeft).Column

'出力シートの行
Dim i As Long
i = 1

'入力シートの2行目から最終行まで繰り返し
For iRow = 2 To rMax
    '入力シート2列目から最終列まで繰り返し
    For iCol = 2 To cMax
            
        '入力シート1行目の日付を絞りたい場合
        Select Case ws1.Cells(1, iCol).Value
            Case "2022/1/1"
            
            '出力シートの1行目→入力シートの1列目（機種）
            ws2.Cells(i, 1).Value = ws1.Cells(iRow, 1).Value
            
            '出力シートの2行目→入力シートの1行目（日付）
            ws2.Cells(i, 2).Value = ws1.Cells(1, iCol).Value
            
            '出力シートの3行目→入力シートの指定の行列がぶつかるところ
            ws2.Cells(i, 3).Value = ws1.Cells(iRow, iCol).Value
            i = i + 1
        
        End Select
    Next
Next
End Sub

2.3　コード例3（一次元配列を使用する場合）

Sub Sample3()
'一次元配列を使用する場合

Dim ws1 As Worksheet
Set ws1 = Worksheets("マトリクス")
Dim ws2 As Worksheet
Set ws2 = Worksheets("リスト")

'配列用変数
Dim Array1(2) As String

'入力シートの行列(iRow：行, iCol：列)
Dim iRow As Long, iCol As Long
    
'入力シートの最大行列(rMax：行, cMax：列)
Dim rMax As Long, cMax As Long
    
'表の最終行取得（2列目）
rMax = ws1.Cells(ws1.Rows.Count, 2).End(xlUp).Row
    
'表の最終列取得（2行目）
cMax = ws1.Cells(2, ws1.Columns.Count).End(xlToLeft).Column


'入力シートの2行目から最終行まで繰り返し
For iRow = 2 To rMax
    '入力シート2列目から最終列まで繰り返し
    For iCol = 2 To cMax
               
            '配列1番目→入力シートの1列目（機種）
            Array1(0) = ws1.Cells(iRow, 1).Value
            
            '配列2番目→入力シートの1行目（日付）
            Array1(1) = ws1.Cells(1, iCol).Value
            
            '配列3番目→入力シートの指定の行列がぶつかるところ
            Array1(2) = ws1.Cells(iRow, iCol).Value
            
            '配列に入れた情報を出力シート最終行の1行下に貼り付け
            ws2.Cells(ws2.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Resize(1, 3) = Array1
    Next
Next

'すべて文字列のため値に変換
ws2.Range("A1").CurrentRegion.Value = ws2.Range("A1").CurrentRegion.Value


End Sub

2次元配列は勉強中。