くまおやぢの雑記帳

50代のオッサンです。気になることを気ままに綴っていきます。最近ではダルマに似てるって言われてます。

エクセルで縦と横を入れ替えるマクロ|Excel_VBA

共同作業をしていると、表などで縦横が逆の場合のことがあります。これを簡単に入れ替える方法についてお伝えします。まず、やり方として3通りあります。

 

1.手作業

これについては説明するまでもなく、ただただひたすらコピペもしくはセルのドラッグの繰り返しです。これでは時間がもったいないのでやめましょう。

2.関数を使う

これはTRANSPOSE関数で簡単にできます例えば、セルA1:D4までのデータを入れ替える場合は任意のセルに=TRANSPOSE(A1:D4)を入力するだけです。

3.マクロを使う

2のTRANSPOSE関数でも十分なのですが、VBAコードもせっかくなのでご紹介します。これは2つの方法があります。同じ位置で縦横を入れ替える方法と、別位置に貼り付ける方法があります。

3-1.縦横を入れ替えるVBAコード_同じ位置

Sub 縦横入れ替え※同位置()
    Dim rng As Range
    Dim tempSheet As Worksheet
    Dim firstCell As Range
    
    ' 選択範囲を設定
    Set rng = Selection
    Set firstCell = rng.Cells(1, 1)
    
    ' 一時的なシートを作成
    Set tempSheet = Sheets.Add
    
    ' 選択範囲を一時的なシートに転置してコピー
    rng.Copy
    tempSheet.Range("A1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    
    ' 転置されたデータを元の位置にコピー
    tempSheet.Range("A1").Resize(rng.Columns.Count, rng.Rows.Count).Copy
    firstCell.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
    ' 一時的なシートを削除
    Application.DisplayAlerts = False
    tempSheet.Delete
    Application.DisplayAlerts = True
    
    ' クリップボードをクリア
    Application.CutCopyMode = False
End Sub

3-2.縦横を入れ替えるVBAコード_別の位置

Sub 縦横入れ替え※別位置()
    Dim rng As Range
    Dim destCell As Range
    
    ' 選択範囲を設定
    Set rng = Selection
    
    ' 転置したデータの貼り付け先を設定(例としてセルG1に貼り付け)
    ' 必要に応じて変更してください
    Set destCell = Application.InputBox("転置データの貼り付け先を選択してください:", Type:=8)
    
    ' 選択範囲をコピーし、転置して貼り付け
    rng.Copy
    destCell.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    
    ' クリップボードをクリア
    Application.CutCopyMode = False
End Sub

ぜひ使ってみてください。