簡単に並び替えをしたい！昇順・降順でソートするVBAコード！

まずは、以下をご覧ください。

組織の階層がバラバラです。これをソートするコードです。

本コードはアクセス権付きフォルダ作成ツールに使われています。  

並び替え（ソート）コード

いつも私が使っているソートのコードを記載します。

' ソート
Sub SortSample()

    Dim wsBoss  As Worksheet
    Set wsBoss = ThisWorkbook.Worksheets("Boss")
    Dim endRow As Long
    ' 最下行取得
    endRow = wsBoss.Cells(Rows.Count, 2).End(xlUp).Row
    ' Bossシートのソート
    ' 空白組織は"0"埋め（完全一致）
    wsBoss.Range("C3:E" & endRow).Replace What:="", Replacement:="0", LookAt:=xlWhole
    'フィルター（昇順）
    With wsBoss.Sort
        ' 過去のソート設定を削除
        .SortFields.Clear
        ' ソートのキーを設定
        .SortFields.Add Key:=Range("B2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("C2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("D2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("E2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        ' ソートの範囲を指定
        .SetRange wsBoss.Range("A2:AW" & endRow)
        ' ヘッダーの有無指定
        .Header = xlYes
        ' 並び替え実行
        .Apply
    End With
    ' 一時的に"0"を埋めた組織は組織をブランクに置換（完全一致）
    wsBoss.Range("C3:E" & endRow).Replace What:="0", Replacement:="", LookAt:=xlWhole
    
End Sub

 

並び替え（ソート）コードの実行結果

以下の画像を見ていただければ、順序のイメージがつくと思います。 人事部の上位階層が上にきています。 また、１，２，３係もちゃんと並んでいますね！

実行後

 

さいごに

VBAは以下に自分で汎用的に使えるサンプルコードを持っておけるかです！ ソートも結構使いますので、ぜひご活用くださいませ！   ではまた。