Sub マトリクス表をデータリストに置き換える()
Dim wsInput As Worksheet
Dim wsOutput As Worksheet
Dim inputRange As Range
Dim outputRange As Range
Dim i As Long, j As Long, k As Long
' マトリクス表があるシートと範囲を指定
Set wsInput = ThisWorkbook.Sheets("Sheet3")
Set inputRange = wsInput.UsedRange
' 出力先のシートとセルを指定
Set wsOutput = ThisWorkbook.Sheets("Sheet4")
Set outputRange = wsOutput.Cells(1, 1)
' マトリクス表をデータリストに変換
For i = 1 To inputRange.Rows.Count
For j = 1 To inputRange.Columns.Count
If inputRange.Cells(i, j).Value <> "" Then
' データがあるセルの値と位置を取得して出力
outputRange.Offset(k, 0).Value = inputRange.Cells(i, 1).Value ' 行の値
outputRange.Offset(k, 1).Value = inputRange.Cells(1, j).Value ' 列の値
outputRange.Offset(k, 2).Value = inputRange.Cells(i, j).Value ' マトリクスの値
k = k + 1
End If
Next j
Next i
' 出力範囲を自動調整
Set outputRange = wsOutput.Range(outputRange, outputRange.Offset(k - 1, 2))
End Sub