Excelで表⇔１列/１行の相互変換やその場で転置

事務作業でこまごまと表を編集するときに、一列になったデータを表形式に書き直したり、その逆を行ったりすることがある。色々データ処理するならピボットテーブルを使うのだが、ごく簡単に配置を変更したときに使える行/列を扱うエクセルマクロ達。

 

使い方

• セル範囲を選ぶ
• マクロを実行する

機能

1. rangeSimplifyToColumn
   表形式から一列形式に変換。
2. rangeSimplifyToRow
   表形式から一行形式に変換。
3. rangeColumnToRange
   一列形式から表形式に変換。
4. rangeRowToRange
   一行形式から表形式に変換。
5. rangeTranspose
   転置（表形式の縦横を入れ替える。）

コード

ちょっと長いですが、やっていることはとてもシンプル。
もっと上手い実装の仕方がありそうな気もする…

Sub rangeSimplifyToColumn()
    Dim sourceRange As Range
    Dim returnRange As Range
    Dim rowCount As Integer
    
    'セル範囲を１つだけ選択している場合しか動作しないようにする。
    If Not TypeName(Selection) = "Range" Then Exit Sub
    If Not Selection.Areas.Count = 1 Then Exit Sub
    
    Set sourceRange = Selection
    
    
    '値を返す範囲を作る
    With sourceRange
        rowCount = .Rows.Count
        Set returnRange = Range(.Cells(1, 1), .Cells(1, 1).Offset(.Cells.Count - 1, 0))
    End With
    
    '値を代入する
    For i = 1 To sourceRange.Columns.Count
        With returnRange
            Range(.Cells((i - 1) * rowCount + 1, 1), .Cells(i * rowCount, 1)).Value = sourceRange.Columns(i).Value
        End With
    Next
    
    '不要な値を削除する
    With sourceRange
        Range(.Columns(2), .Columns(.Columns.Count)).ClearContents
    End With
    
    '出力した範囲を選択する
    returnRange.Select
    
End Sub

Sub rangeSimplifyToRow()
    Dim sourceRange As Range
    Dim returnRange As Range
    Dim colCount As Integer
    
    'セル範囲を１つだけ選択している場合しか動作しないようにする。
    If Not TypeName(Selection) = "Range" Then Exit Sub
    If Not Selection.Areas.Count = 1 Then Exit Sub
    
    Set sourceRange = Selection
    
    '値を返す範囲を作る
    With sourceRange
        colCount = .Columns.Count
        Set returnRange = Range(.Cells(1, 1), .Cells(1, 1).Offset(0, .Cells.Count - 1))
    End With
    
    '値を代入する
    For i = 1 To sourceRange.Rows.Count
        With returnRange
            Range(.Cells(1, (i - 1) * colCount + 1), .Cells(1, i * colCount)).Value = sourceRange.Rows(i).Value
        End With
    Next
    
    '不要な値を削除する
    With sourceRange
        Range(.Rows(2), .Rows(.Rows.Count)).ClearContents
    End With
    
    '出力した範囲を選択する
    returnRange.Select
    
End Sub

Sub rangeColumnToRange()
    Dim sourceRange As Range
    Dim returnRange As Range
    Dim rowCount As Integer
    
    'セル範囲を１列だけ選択している場合しか動作しないようにする。
    If Not TypeName(Selection) = "Range" Then Exit Sub
    If Not Selection.Areas.Count = 1 Then Exit Sub
    If Not Selection.Columns.Count = 1 Then Exit Sub
    
    Set sourceRange = Selection
    
    rowCount = CInt(Application.InputBox(Prompt:="Input number of rows =", Title:="rangeColumnToRange", Type:=1))
   
    '割り切れないときの処理
    
    '値を返す範囲を作る
    With sourceRange
        Set sourceRange = Range(.Cells(1), .Cells(.Cells.Count).Offset(.Cells.Count Mod rowCount))
    End With
    With sourceRange 'sourceRangeをwith sourceRangeの中で更新した場合、Withを分けるか直接指定する必要あり
        Set returnRange = Range(.Cells(1, 1), .Cells(rowCount, 1).Offset(0, Int(.Cells.Count / rowCount) - 1))
    End With

    '値を代入する
    For i = 1 To returnRange.Columns.Count
        With sourceRange
            returnRange.Columns(i).Value = Range(.Cells((i - 1) * rowCount + 1, 1), .Cells(i * rowCount, 1)).Value
        End With
    Next
    
    '不要な値を削除する
    With sourceRange
        Range(.Rows(rowCount + 1), .Rows(.Rows.Count)).ClearContents
    End With
    
    '出力した範囲を選択する
    returnRange.Select
End Sub

Sub rangeRowToRange()
    Dim sourceRange As Range
    Dim returnRange As Range
    Dim colCount As Integer
    
    'セル範囲を１つだけ選択している場合しか動作しないようにする。
    If Not TypeName(Selection) = "Range" Then Exit Sub
    If Not Selection.Areas.Count = 1 Then Exit Sub
    If Not Selection.Rows.Count = 1 Then Exit Sub
    
    Set sourceRange = Selection
    
    colCount = CInt(Application.InputBox(Prompt:="Input number of colmuns =", Title:="rangeRowToRange", Type:=1))
   
    '割り切れないときの処理
    '値を返す範囲を作る
    With sourceRange
        Set sourceRange = Range(.Cells(1), .Cells(.Cells.Count).Offset(.Cells.Count Mod colCount))
    End With
    With sourceRange 'sourceRangeをwith sourceRangeの中で更新した場合、Withを分けるか直接指定する必要あり
        Set returnRange = Range(.Cells(1, 1), .Cells(1, colCount).Offset(Int(.Cells.Count / colCount) - 1, 0))
    End With

    '値を代入する
    For i = 1 To returnRange.Rows.Count
        With sourceRange
            returnRange.Rows(i).Value = Range(.Cells(1, (i - 1) * colCount + 1), .Cells(1, i * colCount)).Value
        End With
    Next
    
    '不要な値を削除する
    With sourceRange
        Range(.Columns(colCount + 1), .Columns(.Columns.Count)).ClearContents
    End With
    
    '出力した範囲を選択する
    returnRange.Select
End Sub

Sub rangeTranspose()
    Dim returnRange As Range
    Dim sourceValue As Variant
    
    'セル範囲を１つだけ選択している場合しか動作しないようにする。
    If Not TypeName(Selection) = "Range" Then Exit Sub
    If Not Selection.Areas.Count = 1 Then Exit Sub
    
    sourceValue = Selection.Value

    '値を返す範囲を作成
    With Selection
        Set returnRange = Range(.Cells(1, 1), .Cells(1, 1).Offset(.Columns.Count - 1, .Rows.Count - 1))
    End With
    
    'いらないデータを消去
    Selection.ClearContents
    
    '転置して出力する
    returnRange.Value = Application.WorksheetFunction.Transpose(sourceValue)
    returnRange.Select
End Sub

変更履歴

2014/3/31 初版