VBAノック36本目：列の並べ替え - 和風スパゲティのレシピ

Excel&VBA解説サイト「エクセルの神髄」様出題の問題集、
「VBA100本ノック」に対する私の回答と解説のページです。

100本ノックの出題リストはこちらから
excel-ubara.com

出題：列の並べ替え
ソースコード
- メインモジュール
- 汎用関数モジュール
解説

出題：列の並べ替え

#VBA100本ノック 36本目
1行目の見出しの後ろには半角括弧()の中に数値が入っています。
この()括弧内の数値の昇順で列を並べ替えてください。
・全ての列に数値の入った()が正しく最後についています。
・数値は1~3桁の正の整数です。
※非表示列はありません。
※シートは任意

データサンプル

◇ 出題ページはこちら
https://excel-ubara.com/vba100/VBA100_0●●.html

ソースコード

メインモジュール

Option Explicit

' 100本ノック036：列の並べ替え
Sub 見出しのカッコ内番号をキーに列を並び換える()
    With WSデータ
    
        ' 見出しの上部に行を挿入して()内番号を抽出
        .Rows(1).Insert
        Dim C As Long
        For C = 1 To Get最終列(WSデータ)
            .Cells(1, C) = Mid文字列から文字列(.Cells(2, C), "(", ")")
        Next
        
        ' 第1行をキーとして列を並び替え
        Dim ソートエリア As Range
        Set ソートエリア = .Range("A1").CurrentRegion
        ソートエリア.Sort .Range("A1"), Orientation:=xlSortRows
        
        ' 作業行を削除
        .Rows(1).Delete
    
    End With
    
End Sub

汎用関数モジュール

Option Explicit

' 文字列の切り出し
Function Mid文字列から文字列(ByVal 元テキスト As String, ByVal 前検索値 As String, ByVal 後検索値 As String _
    , Optional is前検索値を結果に含む As Boolean = False, Optional is後検索値を結果に含む As Boolean = False) As String

    Dim instr前値 As Long: instr前値 = InStr(元テキスト, 前検索値)
    If instr前値 = 0 Then Exit Function

    Dim instr後値 As Long: instr後値 = InStr(instr前値 + Len(前検索値) + 1, 元テキスト, 後検索値)
    If instr後値 = 0 Then Exit Function

    Mid文字列から文字列 = _
        IIf(is前検索値を結果に含む, 前検索値, "") & _
        Mid(元テキスト, instr前値 + Len(前検索値), instr後値 - instr前値 - Len(前検索値)) & _
        IIf(is後検索値を結果に含む, 後検索値, "")

End Function

' 最終列の取得
' 参考：https://www.limecode.jp/entry/library/get-lastrow-lastcolumn
Function Get最終列(指定オブジェクト As Variant, Optional ByVal R As Long = -1) As Long

    ' 渡されたオブジェクトからセル範囲を取得
    Dim 対象セル範囲 As Range
    Select Case TypeName(指定オブジェクト)
    Case "Range"
        If 指定オブジェクト.Cells.CountLarge = 1 Then ' 単独セルにはCurrentRegionを取る
            Set 対象セル範囲 = 指定オブジェクト.CurrentRegion
        Else
            Set 対象セル範囲 = 指定オブジェクト
        End If
    Case "Worksheet"
        Set 対象セル範囲 = 指定オブジェクト.UsedRange
    Case "AutoFilter", "ListObject"
        Set 対象セル範囲 = 指定オブジェクト.Range
    Case Else
        Err.Raise 1000, , "対象外のオブジェクト「" & TypeName(指定オブジェクト) & "」が指定されました。"
    End Select

    ' エリアの最終列を取得
    Get最終列 = 対象セル範囲.Columns.Count + 対象セル範囲.Column - 1

    ' 列が指定されていればその列の入力最終行を取得
    If R <> -1 Then
        Do While 対象セル範囲.Worksheet.Cells(R, Get最終列) = ""
            Get最終列 = Get最終列 - 1
            If Get最終列 < 対象セル範囲.Column Then
                Get最終列 = 0
                Exit Function
            End If
        Loop
    End If

End Function