【Excel VBA】2つの列を入れ替えるマクロ

Excelを使っていると、ときどき列（行）を入れ替えたくなるときがある。

列を入れ替える時の操作
入れ替えるマクロを作ってみる
マクロの使い方
注意点

列を入れ替える時の操作

列（行）を入れ替えるのは結構面倒で、通常以下のような手順を踏まなければいけない。

列を選択する
選択した列を「切り取り」
入れ替えたい列の前（後）に挿入
入れ替えたい列を選択する
「切り取り」
先ほどの列があった場所に挿入

または

1つ目の列を選択する
範囲の外枠をシフトキーを押しながらドラッグ
2つ目の列でもう一度同じ操作をおこなう

というところか。

前者の方法は面倒で、後者の方法は「シフトキーを押しながら」というのを忘れていて上書きされてしまったり、外枠がうまく掴めなくてイラッとしたりすることもある。

入れ替えるマクロを作ってみる

もしかするとマクロを使って対処した方がやりやすいかもしれない。

上記2つの方法は結局どちらも「列を移動する」ということを2回おこなっているだけである。「移動する」を2回おこなえば結局は「入れ替える」と同等のことになるのだが、「入れ替える」を「移動を2回おこなう」に変換するのが苦手な人もいるかもしれない。この考え方の変換はそれなりに柔軟な発想だと思う。

そこでまさに「入れ替える」行ないをするマクロを作成してみる。以下、ソース。

Option Explicit

Public Sub ExchangeColumns()
    Dim userSelectCell As Range
    Dim tgtRange_1 As Range
    Dim tgtRange_2 As Range
    Dim tgtValue_1 As Variant
    Dim tgtValue_2 As Variant
    
    '現在選択されているセルの列をRangeオブジェクトに代入
    Set tgtRange_1 = Range(Selection.End(xlUp), Selection.End(xlDown))
    
    ' 入れ替える列をインプットボックスで聞く
    ' このときマウスで入れ替え列のどれかのセルをクリックするだけでよい
    ' キャンセルが押されると何もせずに終了される
    On Error GoTo ExchangeColumns_Error
    Set userSelectCell = Application.InputBox( _
        Prompt:="1st Column : " & tgtRange_1.Address & vbCrLf & "Select 2nd Column", _
        Title:="Click And Select Any Cell(s)", _
        Type:=8)
    On Error GoTo 0
    
    ' 入れ替え列をオブジェクトに代入
    Set tgtRange_2 = Range(userSelectCell.End(xlUp), userSelectCell.End(xlDown))
    
    ' それぞれの列の値を記憶
    tgtValue_1 = tgtRange_1.Value
    tgtValue_2 = tgtRange_2.Value
    
    ' それぞれの列の値を入れ替えてオブジェクトに代入
    Application.ScreenUpdating = False
    tgtRange_1.Value = tgtValue_2
    tgtRange_2.Value = tgtValue_1
    Application.ScreenUpdating = True
    
ExchangeColumns_Error:
    ' オブジェクトを破棄
    Set userSelectCell = Nothing
    Set tgtRange_1 = Nothing
    Set tgtRange_2 = Nothing
End Sub