hiko-blog

VBA業務改善

MENU

マトリクス表をデータリストに置き換える

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