テーブル機能の備忘録 ⑦ ラベル名で列を移動

先日から、マクロによるテーブル機能の扱いを纏めている（備忘録）。
infoment.hatenablog.com
今日は、たまたま仕事で出くわした課題から抜粋。

「Ｄ列とＣ列を自動で入れ替えられませんか？」
こんな相談を受けた。奇しくも対象は、テーブルとして書式設定されている。
つまり、こんな感じだ。

そこで、こんなものを作ってみた。
ラベル名で指定するため、レイアウトが変わっても問題ない。
※ラベル名を変更されたら、流石にどうしようもないが。

Sub MoveColumn(Tb As ListObject, _
               source_column_label As String, _
               destination_column_label As String, _
      Optional shift_direction As XlDirection = xlToRight)

    ' 移動元の列番号。
    Dim s_index As Long
        s_index = Tb.ListColumns(source_column_label).Index
    ' 移動先の列番号。
    Dim d_index As Long
        d_index = Tb.ListColumns(destination_column_label).Index

    ' 挿入された列をずらす方向。
    Select Case shift_direction
        Case XlDirection.xlToLeft
            shift_direction = xlToLeft

        ' xlUpやxlDownを指定された場合の対策。
        Case Else
            shift_direction = xlToRight
    End Select

        Tb.Range.Columns(s_index).Cut
        Tb.Range.Columns(d_index).Insert Shift:=shift_direction

        Application.CutCopyMode = False
End Sub

やっていることは、列を切り取って挿入するだけ。使い方は、こんな感じだ。

Sub test()
    Call MoveColumn(ActiveSheet.ListObjects(1), "アドレス", "ふりがな")
End Sub

存在しないラベルを指定するとエラーになるため、ここは敢えて、
関数にするのもアリかも。

Function MoveColumn(Tb As ListObject, _
                    source_column_label As String, _
                    destination_column_label As String, _
           Optional shift_direction As XlDirection = xlToRight) As Boolean
        
    On Error GoTo er:

    ' 移動元の列番号。
    Dim s_index As Long
        s_index = Tb.ListColumns(source_column_label).Index
    ' 移動先の列番号。
    Dim d_index As Long
        d_index = Tb.ListColumns(destination_column_label).Index

    ' 挿入された列をずらす方向。
    Select Case shift_direction
        Case XlDirection.xlToLeft
            shift_direction = xlToLeft

        ' xlUpやxlDownを指定された場合の対策。
        Case Else
            shift_direction = xlToRight
    End Select

        Tb.Range.Columns(s_index).Cut
        Tb.Range.Columns(d_index).Insert Shift:=shift_direction

        Application.CutCopyMode = False
    
    ' 移動成功の場合の戻り値。
    MoveColumn = True
    Exit Function

er:
    ' 移動失敗の場合の戻り値。
    MoveColumn = False
    
End Function

単純に、上手く行ったらTrueを返し、失敗したらFalseを返している。
使い方としては、こんな感じかな。

Sub test()
    If MoveColumn(ActiveSheet.ListObjects(1), "アドレス", "ふりがな") Then
        何某かの処理
    Else
        エラーの場合の処理
    End If
End Sub

使い方・使い処は、各位のお好みで。

明日に続きます。

参考まで。