ある表を決められたルールで並び替え　③ 書き出したキーを並び順の数字に置き換え

一昨日からの「並び替えに関する課題」について、少しずつ進めている。
昨日は、並び替えのキーとなる部分を、正規表現を用い抽出して、表の最終列に書き出した。
infoment.hatenablog.com
今日は書き出したキーを、並び替えの順序を示す数字に置き換えてみる。

f:id:Infoment:20200218214814j:plain

色々と考えてみたが、今回は並び替えの対応表を作成して、辞書（連想配列）にすることにした。

↓ 「並び順」シートに作成した、「並び順」テーブルがこちら。
f:id:Infoment:20200218215205p:plain

これで、辞書を作成してみよう。

Public Property Get SortDict() As Scripting.Dictionary
    Dim Tb As ListObject
    Set Tb = Sheets("並び順").ListObjects(1)
    
    Dim Dict As Scripting.Dictionary
    Set Dict = New Scripting.Dictionary
    
    Dim ListRow As Excel.ListRow
        For Each ListRow In Tb.ListRows
            With ListRow.Range
                Dict(.Cells(1).Value) = .Cells(2).Value
            End With
        Next
    
    Set SortDict = Dict
End Property

昨日のキー書き出し部をアレンジし、再掲したのがこちら。

Sub 並べ替え()
    ' 元データ保護のため、シートごとコピーして並べ替え。
    Dim Sh(1) As Worksheet
        ActiveSheet.Copy After:=ActiveSheet
    Set Sh(0) = ActiveSheet
        Sh(0).Name = "並べ替え後"
        
    ' 正規表現。
    Dim myReg As Object
    Set myReg = CreateObject("VBScript.RegExp")
    ' パターン定義。
    ' 一文字以上の英字のあとに、一回以上連続してスペースが続く。
    ' その後に英字が３文字続き、ピリオドののち、商品名となる。
    ' 今回必要なのは、英字が３文字続く部分。
        myReg.Pattern = "^[A-Z]+\s+([A-Z]{3})\..*$"
    
    ' A列をループで確認。キーとなるコードをE列に書き出す。
    Dim MC As Object ' MatchCollection
    Dim Dict As Scripting.Dictionary
    Set Dict = SortDict
    Dim r As Range
        For Each r In Range("A2:A6")
            If myReg.Test(r) Then
                Set MC = myReg.Execute(r)
                Dim temp As String
                    temp = MC(0).SubMatches(0)
                    If Dict.Exists(temp) Then
                        Cells(r.Row, "E") = Dict(temp)
                    End If
            End If
        Next
End Sub