VBA100本ノック 36本目:列の並べ替え

こちらで公開されている、100本ノックに挑戦。
www.excel-ubara.com
素晴らしい教材を公開いただき、ありがとうございます。

上記リンク先から、問題文を転載。

( )内の数字で並べ替えるわけだが、( )以外の表記に一貫性がない。
従って、単純な並び替えでは上手くいかなそうだ。

ということで今回は、正規表現を用いて一旦数字だけを抽出し、この情報を
元に並び替えることとした。

Sub VBA_100Knock_36()
    ' ( )内の数字を正規表現で抽出。
    Dim myReg As VBScript_RegExp_55.RegExp
    Set myReg = New VBScript_RegExp_55.RegExp
        myReg.Pattern = "\((\d+)\)"
    Dim MC As VBScript_RegExp_55.MatchCollection
        
    Dim arr As Variant
        arr = Range("A1").CurrentRegion
    
    ' ラベル行の()内の数字を、ラベル文字先頭に表示。
    ' 桁数を揃えるため、書式「K000」にしている。
    ' Kは、Sort KeyのK。
    Dim i As Long
        For i = 1 To UBound(arr, 2)
            If myReg.Test(arr(1, i)) Then
                Set MC = myReg.Execute(arr(1, i))
                arr(1, i) = Format(MC(0).SubMatches(0), "K000") & _
                            "_" & arr(1, i)
            End If
        Next
    
    ' 元のデータを一旦クリアし、縦横変換して貼り付け。
        Range("A1").CurrentRegion.ClearContents
        Range("A1").Resize(UBound(arr, 2), UBound(arr, 1)) = _
                                    WorksheetFunction.Transpose(arr)
    
    ' 一列目でソート。
    Dim Sh As Worksheet: Set Sh = ActiveSheet
        Sh.Sort.SortFields.Clear
        Sh.Sort.SortFields.Add Key:=Range("A1")
        With Sh.Sort
            .SetRange Range("A1").CurrentRegion
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    
    ' 配列に格納して、もう一度縦横変換。
        arr = Sh.Range("A1").CurrentRegion
        arr = WorksheetFunction.Transpose(arr)
    
    ' ラベルに追加した、ソート用の「K000」を除去。
    Dim Temp As Variant
        For i = 1 To UBound(arr, 2)
            Temp = Split(arr(1, i), "_")
            If UBound(Temp) <> 0 Then
                arr(1, i) = Temp(1)
            End If
        Next
    
    ' 並べ替えに使用したデータをクリアして、並べ替え後の配列を貼り付け。
        Range("A1").CurrentRegion.ClearContents
        Range("A1").Resize(UBound(arr, 1), UBound(arr, 2)) = arr
End Sub

↓ 結果がこちら。

※冒頭リンク先の解答例および解説も、ぜひご一読ください。

参考まで。