Copilotでクロス表を縦持ちデータに変換｜配列で高速化する

ご要望に基づき、配列を使用して高速化したコードを以下に提示します。

Option Explicit
Sub ConvertCrossToLong_Fast()

'--------------------------------------------
'【1】シートの定義
'--------------------------------------------
Dim wsSource As Worksheet ' 元データ：data シート
Dim wsOutput As Worksheet ' 出力先：data2 シート
Set wsSource = Worksheets("data")
Set wsOutput = Worksheets("data2")

'--------------------------------------------
'【2】出力先シートの初期化
'--------------------------------------------
wsOutput.Cells.ClearContents

'--------------------------------------------
'【3】元データの最終行・最終列を取得
'--------------------------------------------
Dim lastRow As Long
Dim lastCol As Long
lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
lastCol = wsSource.Cells(1, wsSource.Columns.Count).End(xlToLeft).Column

'--------------------------------------------
'【4】元データを配列に読み込み
'--------------------------------------------
Dim srcData As Variant
srcData = wsSource.Range(wsSource.Cells(1, 1), wsSource.Cells(lastRow, lastCol)).Value

'--------------------------------------------
'【5】出力件数を計算（行数 × 年月列数）
'--------------------------------------------
Dim itemCount As Long
Dim ymCount As Long
itemCount = lastRow - 1 ' データ行数（2行目～）
ymCount = lastCol - 2 ' 年月列数（3列目～）

Dim totalRows As Long
totalRows = itemCount * ymCount ' 出力行数

'--------------------------------------------
'【6】出力用配列を作成（ヘッダー＋データ）
'--------------------------------------------
Dim outArr() As Variant
ReDim outArr(1 To totalRows + 1, 1 To 4)

' ヘッダー設定
outArr(1, 1) = "品目番号"
outArr(1, 2) = "品目名称"
outArr(1, 3) = "年月"
outArr(1, 4) = "原指数"

'--------------------------------------------
'【7】配列に縦持ちデータを格納
'--------------------------------------------
Dim r As Long, c As Long
Dim outRow As Long
Dim ym As Variant

outRow = 2

For r = 2 To lastRow

    For c = 3 To lastCol

        ' 年月（1行目）
        ym = srcData(1, c)

        ' 出力配列に格納
        outArr(outRow, 1) = srcData(r, 1) ' 品目番号
         outArr(outRow, 2) = srcData(r, 2) ' 品目名称

        ' 年月を yyyy/m 形式に統一
        If IsDate(ym) Then
            outArr(outRow, 3) = Format(ym, "yyyy/m")
        Else
            outArr(outRow, 3) = ym
        End If

        ' 原指数
        outArr(outRow, 4) = srcData(r, c)

        outRow = outRow + 1

    Next c
Next r

'--------------------------------------------
'【8】配列を一括で書き込み
'--------------------------------------------
wsOutput.Range("A1").Resize(UBound(outArr, 1), 4).Value = outArr

'--------------------------------------------
'【9】書式設定（カンマ区切り）
'--------------------------------------------
wsOutput.Columns(4).NumberFormatLocal = "#,##0"

'--------------------------------------------
'【10】列幅を自動調整
'--------------------------------------------
wsOutput.Columns.AutoFit

'--------------------------------------------
'【11】完了メッセージ
'--------------------------------------------
MsgBox "高速版：クロス表の縦持ち変換が完了しました。", vbInformation

End Sub