マトリックスからリストへの変換

初めに

VBA勉強会のお題を自分がどのように実装したのかをまとめたいと思います。
今回ググらずに自分の考えで実装したので効率面などはそこまで考慮できておりません。
ご了承ください。

課題内容

マトリックス表をリストに変換する。
目的はマトリックスでは見えない部分を、グラフなどで可視化するため。
要件として、項目（プログラミング言語）は今後増える可能性を考慮して拡張性を持たせておいてください。※社員情報の３列は増えないものとする

※使用するデータはオリジナルで作成したもので、ダミーデータとなります。

こちらマトリックス表

こちら出力イメージ

コード内容

Option Explicit
Option Base 1

Sub main()

Application.ScreenUpdating = False

'シート
Dim wsMatrix As Worksheet
Dim wsOutput As Worksheet
Set wsMatrix = ThisWorkbook.Sheets("マトリックス表")
Set wsOutput = ThisWorkbook.Sheets("出力先")

'行列格納用
Dim lastRow As Long: lastRow = wsMatrix.Cells(Rows.Count, 1).End(xlUp).Row
Dim lastcol As Long: lastcol = wsMatrix.Cells(1, Columns.Count).End(xlToLeft).Column

'項目数格納用
Dim n As Long: n = lastcol - 3

'配列
Dim arr() As Variant                '主となるデータ
Dim arrSyainInfo() As Variant       '社員情報（社員ID、部署、名前）
Dim arrLabel() As Variant           '項目ラベル（Python,VBA,Java..）
Dim arrScore() As Variant           '各項目ごとの点数

'カウント
Dim i As Long
Dim j As Long

wsMatrix.Select
'データを配列に格納
arr = wsMatrix.Range(Cells(2, 1), Cells(lastRow, lastcol))
'項目名を配列に格納
arrLabel = wsMatrix.Range(Cells(1, 4), Cells(1, lastcol))

wsOutput.Select

For i = 1 To UBound(arr)
    '最終行を取得
    lastRow = wsOutput.Cells(Rows.Count, 1).End(xlUp).Row
    '社員情報を格納＆転記
    arrSyainInfo = WorksheetFunction.Index(arr, i, Array(1, 2, 3))
    wsOutput.Range(Cells(lastRow + 1, 1), Cells(lastRow + n, 3)) = arrSyainInfo
    '項目名を転記
    wsOutput.Range(Cells(lastRow + 1, 4), Cells(lastRow + n, 4)) = WorksheetFunction.Transpose(arrLabel)
    '点数格納用の配列を初期化
    ReDim arrScore(1, n)
    '配列から点数部分のみを抽出して配列に格納
    For j = 1 To n
        arrScore(1, j) = arr(i, j + 3)
    Next
    '点数を転記
    wsOutput.Range(Cells(lastRow + 1, 5), Cells(lastRow + n, 5)) = WorksheetFunction.Transpose(arrScore)
Next

End Sub

解説

まず初めに最終行と最終列を取得し、マトリックス表をすべて配列Arrに格納します

最終行列を取得

'行列格納用
Dim lastRow As Long: lastRow = wsMatrix.Cells(Rows.Count, 1).End(xlUp).Row
Dim lastcol As Long: lastcol = wsMatrix.Cells(1, Columns.Count).End(xlToLeft).Column

見出しを含めずにすべての要素を配列に格納

'データを配列に格納
arr = wsMatrix.Range(Cells(2, 1), Cells(lastRow, lastcol))

要件にあった今後項目が増える可能性を考慮する点については、最終列数からー３したもの（社員情報を抜いた数）を変数に格納し、使用していきます。
項目名についても配列に格納します。
項目名格納時は、１行目の見出しの４列目以降すべてを格納します。

'項目数を格納
Dim n As Long: n = lastcol - 3

'項目名を配列に格納
arrLabel = wsMatrix.Range(Cells(1, 4), Cells(1, lastcol))

For文による繰り返し

For i = 1 To UBound(arr)
    '最終行を取得
    lastRow = wsOutput.Cells(Rows.Count, 1).End(xlUp).Row
    '社員情報を格納＆転記
    arrSyainInfo = WorksheetFunction.Index(arr, i, Array(1, 2, 3))
    wsOutput.Range(Cells(lastRow + 1, 1), Cells(lastRow + n, 3)) = arrSyainInfo
    '項目名を転記
    wsOutput.Range(Cells(lastRow + 1, 4), Cells(lastRow + n, 4)) = WorksheetFunction.Transpose(arrLabel)
    '点数格納用の配列を初期化
    ReDim arrScore(1, n)
    '配列から点数部分のみを抽出して配列に格納
    For j = 1 To n
        arrScore(1, j) = arr(i, j + 3)
    Next
    '点数を転記
    wsOutput.Range(Cells(lastRow + 1, 5), Cells(lastRow + n, 5)) = WorksheetFunction.Transpose(arrScore)
Next

転記先へ転記する際は、１つの項目が転記終わったら、最終行を新たに取得して、その最終行についかしていくという流れで、今回一括代入ではありません。（拙いコードで申し訳ありません）

社員情報の転記

'社員情報を格納＆転記
    arrSyainInfo = WorksheetFunction.Index(arr, i, Array(1, 2, 3))
    wsOutput.Range(Cells(lastRow + 1, 1), Cells(lastRow + n, 3)) = arrSyainInfo

WorksheetFunction.Indexは、指定した配列のインデックスを指定するとその要素を取得できるものになります。
社員情報の欄は、配列の(i, 1)(i, 2)(i, 3)と固定されているため、Array（1, 2, 3）で取得します。

配列Arrの中身

切り出し後arrSyainInfoの中身

社員情報を転記する際は、行をn（プログラミング言語の要素数）の分だけ拡張して転記します。

出力はこんな感じになります。

次に項目名の転記ですが、転記する際に配列の転置（行列の入れ替え）を行う必要があります。

配列を転置して転記

'項目名を転記
wsOutput.Range(Cells(lastRow + 1, 4), Cells(lastRow + n, 4)) = WorksheetFunction.Transpose(arrLabel)

arrLabelの配列はこのようになっています。

転置しない場合の出力はこうなります。
思った動きと違います。arrLabel(1)が範囲拡張されて転記されているような形になっています。

転置した場合の出力はこちらになります。

次に点数部分の転記です、
点数の配列は、Worksheet.Function.Indexを使用できません。
理由は要素数が増える可能性があるため、インデックスを指定できないからになります。

点数の配列の取り出し

'社員情報は要素数が固定されているので1, 2, 3と指定できるが
arrSyainInfo = WorksheetFunction.Index(arr, i, Array(1, 2, 3))
'【例】同じように取得はできるが、要素増えたら対応できない（コードを修正、9を追加する必要が出てくる）
arrScore = WorksheetFunction.Index(arr, i, Array(4, 5, 6, 7, 8))

そのため違うやり方で点数を取得していきます。
具体的には、Forを利用し、新しい配列に値を代入していく流れになります。

arrScoreを繰り返し毎に初期化して使いまわしています。
項目数（n）の数だけ領域を確保します。

ループごとに配列を初期化

'点数格納用の配列を初期化
ReDim arrScore(1, n)

カウンタｊを使用し、nの数だけarrから要素を取り出していき、arrScoreに代入します。

'配列から点数部分のみを抽出して配列に格納
For j = 1 To n
    arrScore(1, j) = arr(i, j + 3)
Next

作成したarrScoreの中身はこちらになります。

こちらのまた２次元方向に値が格納されているので、配列を転置し、転記します。

転置＆転記

'点数を転記
wsOutput.Range(Cells(lastRow + 1, 5), Cells(lastRow + n, 5)) = WorksheetFunction.Transpose(arrScore)

出力はこうなります。

以降マトリックスの行数の数繰り返すということになります。

終わりに

5000行ほどの転記で、速度的には1秒かからないのでパフォーマンスに関しては現状問題ないですが、何倍も増えてくると、一括転記も検討した方がよいかもしれませんね。
常に100点満点のマクロを作ろうとしなくてもいいかという私の考えが表れています(笑)

最後に

せっかくなので整形したデータを活用して可視化してみます。
PowerBIを使用します。
部署ごとに言語平均を出してみましたーというものです。

データソースの中身は先ほど作成したリスト形式のデータベースです。

以上