Excel VBA 逆引き集 | JOIN結果の行ソート

Excel VBA
スポンサーリンク

JOIN結果の行ソート

JOINした表は「見やすさ」「検算」「配布」で並び替えがほぼ必須。安全に壊さず、初心者でも使えるソートのテンプレを用意しました。ポイントは「範囲を正しく指定」「見出しの有無」「複数キーの順序」「数値/日付の型を揃える」です。


よく使う並び替えパターン

  • 単一キーで昇順: コードや名称でシンプルに並べる
  • 複数キーで優先順位: カテゴリ→名称→コードなど段階的に
  • 数値・日付で正しい順: 金額/平均/最新日での昇降順
  • 安定性重視: 元行順を保ちながらキーで並べる(安定ソート)

まずは基本:CurrentRegionを丸ごとソート(ヘッダーあり)

JOIN結果が「A1から見出し付きの矩形範囲」にある前提の最短コードです。

Sub Sort_JoinResult_Basic()
    '対象: Sheet("統合結果") の A1 起点の表(ヘッダーあり)
    Dim ws As Worksheet: Set ws = Worksheets("統合結果")
    Dim rg As Range: Set rg = ws.Range("A1").CurrentRegion
    
    With ws.Sort
        .SortFields.Clear
        'キー1: コード(A列)を昇順
        .SortFields.Add Key:=rg.Columns(1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange rg
        .Header = xlYes
        .Apply
    End With
End Sub
VB
  • ポイント
    • 範囲: CurrentRegion は表全体を一発指定。
    • ヘッダー: 見出し行があるなら .Header = xlYes
    • キー列: 列番号ではなく rg.Columns(n) とすると安全。

複数キーで並び替え(カテゴリ→名称→コード)

優先順位をつけて「分類の塊の中で名前順、その中でコード順」に。

Sub Sort_JoinResult_MultiKeys()
    Dim ws As Worksheet: Set ws = Worksheets("統合結果")
    Dim rg As Range: Set rg = ws.Range("A1").CurrentRegion
    '列定義例: A=コード, B=名称, C=カテゴリ
    
    With ws.Sort
        .SortFields.Clear
        '1) カテゴリ(C列)昇順
        .SortFields.Add Key:=rg.Columns(3), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        '2) 名称(B列)昇順
        .SortFields.Add Key:=rg.Columns(2), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        '3) コード(A列)昇順
        .SortFields.Add Key:=rg.Columns(1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

        .SetRange rg
        .Header = xlYes
        .Apply
    End With
End Sub
VB
  • ポイント
    • 優先順: 追加した順に優先度が高い。
    • 文字列比較: コード/名称は文字列として並ぶ。数値は次のテンプレへ。

数値・日付を正しく並べる(型の明示)

JOIN列が文字列になっていると「10が2より前」などの事故が起きます。並び替え前に型を整えます。

Sub Sort_JoinResult_NumericDate()
    Dim ws As Worksheet: Set ws = Worksheets("統合結果")
    Dim rg As Range: Set rg = ws.Range("A1").CurrentRegion
    '列定義例: D=合計金額(数値), E=平均(数値), F=最新日付(日付)

    '型の整形(書式ではなく中身の型を数値/日付へ)
    ws.Range("D2:D" & rg.Rows.Count).Value = ws.Evaluate("IF(ROW(D2:D" & rg.Rows.Count & "),VALUE(D2:D" & rg.Rows.Count & "))")
    ws.Range("E2:E" & rg.Rows.Count).Value = ws.Evaluate("IF(ROW(E2:E" & rg.Rows.Count & "),VALUE(E2:E" & rg.Rows.Count & "))")
    ws.Range("F2:F" & rg.Rows.Count).NumberFormat = "yyyy-mm-dd" '見た目書式

    With ws.Sort
        .SortFields.Clear
        '金額降順→最新日付降順→名称昇順
        .SortFields.Add Key:=rg.Columns(4), SortOn:=xlSortOnValues, Order:=xlDescending
        .SortFields.Add Key:=rg.Columns(6), SortOn:=xlSortOnValues, Order:=xlDescending
        .SortFields.Add Key:=rg.Columns(2), SortOn:=xlSortOnValues, Order:=xlAscending

        .SetRange rg
        .Header = xlYes
        .Apply
    End With
End Sub
VB
  • ポイント
    • 数値化: VALUE() 相当で文字→数値に。式が嫌なら CDbl(Val(...)) を出力段階で使う。
    • 日付: セル中身が日付型なら適切に並ぶ。書式は見た目のため。

見出し名から列を特定して壊れないソート

列順が変わりうる実務では、見出し名からキー列を見つけて並び替えましょう。

Private Function FindHeader(ByVal headerRow As Range, ByVal name As String) As Long
    Dim hit As Range
    Set hit = headerRow.Find(What:=name, LookAt:=xlWhole, LookIn:=xlValues, MatchCase:=False)
    FindHeader = IIf(hit Is Nothing, 0, hit.Column - headerRow.Cells(1, 1).Column + 1) 'CurrentRegion基準の相対列
End Function

Sub Sort_JoinResult_ByHeaders()
    Dim ws As Worksheet: Set ws = Worksheets("統合結果")
    Dim rg As Range: Set rg = ws.Range("A1").CurrentRegion

    Dim cCat As Long: cCat = FindHeader(rg.Rows(1), "カテゴリ")
    Dim cName As Long: cName = FindHeader(rg.Rows(1), "名称")
    Dim cAmt As Long:  cAmt  = FindHeader(rg.Rows(1), "合計金額")
    If cCat * cName * cAmt = 0 Then
        MsgBox "見出し不足(カテゴリ/名称/合計金額)": Exit Sub
    End If

    With ws.Sort
        .SortFields.Clear
        .SortFields.Add Key:=rg.Columns(cCat),  SortOn:=xlSortOnValues, Order:=xlAscending
        .SortFields.Add Key:=rg.Columns(cAmt),  SortOn:=xlSortOnValues, Order:=xlDescending
        .SortFields.Add Key:=rg.Columns(cName), SortOn:=xlSortOnValues, Order:=xlAscending
        .SetRange rg
        .Header = xlYes
        .Apply
    End With
End Sub
VB
  • ポイント
    • 相対列: CurrentRegion の先頭からの列番号を算出して安全に指定。
    • 早期検知: 見出しが見つからないときはメッセージで停止。

配列をソートしてから貼る(大量行向け)

JOINの出力配列をメモリ上で並べ替えてから一括貼付すると高速です。簡易な安定ソート例(キー1つ)。

Sub SortArrayAndDump()
    'out配列: 1行目ヘッダー、2行目以降データ、列2がソートキー(名称)とする
    Dim out() As Variant
    '... ここで JOIN 生成済みの out を用意している前提 ...

    Dim firstRow As Long: firstRow = 2
    Dim lastRow As Long: lastRow = UBound(out, 1)
    Dim i As Long, j As Long, tmp As Variant

    '単純挿入ソート(読みやすさ重視・中規模まで)
    For i = firstRow + 1 To lastRow
        tmp = out(i, 1) '1列目だけでなく行全体を扱いたいので別法に
        '→行ごと一時退避するため、行配列を使う
    Next
End Sub
VB

配列の行ごと入れ替えは少し長くなるため、実務では以下の方針が現実的です。

  • 現実策1: シートに貼って Range.Sort を使う(最も簡単)
  • 現実策2: キー+元行順の「インデックス配列」を作り、インデックスだけ並べ替えてから行を並べて出力(高速・安定)

必要なら、あなたの列構成に合わせて配列ソートの最短コードを仕立てます。


安定ソート(元の行順を保持)の小ワザ

  • ヘルパー列: 貼り付け前に「行番号」を列Zに入れる
    • 並び替え: 目的のキー→最後に「行番号」昇順を条件に追加
    • 元順を壊さずキーで並べ替えられる

例題で練習

'例1:単一キーで昇順に並べる
Sub Example_SortBasic()
    Sort_JoinResult_Basic
End Sub

'例2:カテゴリ→名称→コードの複数キーソート
Sub Example_SortMulti()
    Sort_JoinResult_MultiKeys
End Sub

'例3:金額降順・最新日付降順・名称昇順
Sub Example_SortNumericDate()
    Sort_JoinResult_NumericDate
End Sub

'例4:見出し名で列特定して安全にソート
Sub Example_SortByHeaders()
    Sort_JoinResult_ByHeaders
End Sub
VB
タイトルとURLをコピーしました