VBA 若い番号順に並べ替え

目次
　１　閲覧対象者
　２　得られる効果
　３　設計
　４　コードの解説　
　５　感想　

１　閲覧対象者

製品データ等を、若い番号順に並べ替えたい人。

２　得られる効果

帳票作成時の並べ替えで、製品番号順に処理ができる。
DIctionaryの機能を多少理解できる。

３　設計

以下のような製品No順に並べ替えてあるデータがあります。これを右のように若い番号順に並べ替えって通常の並べ替え機能では作成不可能です（ワイが知らないだけ！？）。

この場合、別の列に製品名の若番号を振る（列F）必要があります。
この「若番号を振る」処理をDIctionaryを使ってやってみます。正直、2次元配列を使えば済む話なんですが、あえてDIctionaryを使ってみます。この方が処理が早いらしいのです。
今回は簡単な例で、データ少ないのでなんとも言えませんが(;^ω^)とりあえずやってみましょう。

写真データの製品Cに注目してください。データの若番号順に並べ替えるということは、製品C４つのデータに対して若番号である「268」を振る必要があります。その処理をDIctionaryを使って実装します。
列Fに各製品に対する若番号を付与し、最後に若番号（列F）、製品名（列D）で並べ替えます。

４　コードの解説

Sub Sort_dict()

Rem 若番号順に製品名を並べ替える。（データが、製品Noの昇順で並べ替えられていることが前提）
    
    Dim sh As Worksheet
    Dim cr As Range
    Dim k_cr
    Dim myDict_YoungNo
    
    Set myDict_YoungNo = CreateObject("Scripting.Dictionary")
    Set sh = Worksheets("Sheet3")
    Set cr = sh.Range("A1").CurrentRegion.Resize(, 6)
    
    
    '製品名の若番を求める。
    On Error Resume Next
    
    For k_cr = 2 To cr.Rows.Count
        myDict_YoungNo.Add cr.Cells(k_cr, 4).Value, cr.Cells(k_cr, 3).Value
    Next
    
    On Error GoTo 0
    
    
    '列に若番を追加
    For k_cr = 2 To cr.Rows.Count
        cr.Cells(k_cr, 6) = myDict_YoungNo(CStr(cr.Cells(k_cr, 4)))
    Next
    
    
    '若番順に並べ替え
    cr.Sort key1:=Range("F1"), key1:=Range("D1"), Header:=xlYes
    
End Sub

解説

まず、列Fに転記できるように変数crはResize(, 6)でsetします。次に、DIctionaryの「myDict_YoungNo」のkeyに製品名、itemに製造番号を加えます。
keyに重複した値を入れることはできないので、製品Noで並べ替えられたデータであるということが前提です。必要であれば処理の追加をします。
これで製品名ごとの若番号がmyDict_YoungNoに取得することができました。

次に、列Fに若番号を代入します。
これはcrをループします。製品名をKeyとして、対象の連想配列のItemが代入されます。