Excelでグループごとに縦横変換したい、ということがあったのでメモ。
グループごとの縦横変換とは
下図↓のようなグループを、
このように↓したいということです。グループごとの項目数は可変になる場合も考慮して、縦横変換したいと思いました。
すでに答えはあった
同じようなことをしたい人はすでにいたようで、まさにコレ!というものを見つけました。まさにベストアンサー。
少しアレンジ
上記の例では同一シート内に変換結果を出力していましたので、別シートに出力するようにしました。
A列、B列に値を置いておけばOKなはず。
Option Explicit Sub グループ縦横変換() Const SHEET_NAME As String = "converted" Dim beginRowNum As Long Dim maxRowNum As Long Dim tmpRange As Range Application.ScreenUpdating = False ' A列最上行の行番号を取得 beginRowNum = A列の最上行の行番号を取得する() ' B列最下行の行番号を取得 maxRowNum = B列最下行の行番号を取得する() ' 結果用シートを同ブック末尾に追加 ActiveWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count) Worksheets(Worksheets.Count).Name = SHEET_NAME ' グループごとの縦横変換 For Each tmpRange In Worksheets(1).Range("B" & beginRowNum & ":B" & maxRowNum) ' A列に値があったら行頭としてコピー If tmpRange.Offset(, -1).Value <> "" Then tmpRange.Offset(, -1).Copy Worksheets(SHEET_NAME).Cells(Rows.Count, 1).End(xlUp).Offset(1) End If ' B列を縦横変換 tmpRange.Copy Worksheets(SHEET_NAME).Cells(Cells(Rows.Count, 1).End(xlUp).Row, Columns.Count).End(xlToLeft).Offset(, 1) Next Application.ScreenUpdating = True End Sub Function A列の最上行の行番号を取得する() Dim tmpRange As Range Dim beginRowNum As Long Set tmpRange = ActiveSheet.Cells(1, 1) beginRowNum = tmpRange.End(xlDown).Row Set tmpRange = Nothing A列の最上行の行番号を取得する = beginRowNum End Function Function B列最下行の行番号を取得する() Dim tmpRange As Range Dim maxRowNum As Long Set tmpRange = ActiveSheet.Cells(Rows.Count, 2) maxRowNum = tmpRange.End(xlUp).Row Set tmpRange = Nothing B列最下行の行番号を取得する = maxRowNum End Function