VBA 配列に詰めたデータを昇順で表示させたい。

Question

実現したいこと

配列に詰めたデータを昇順で表示させたい

データ

現状ソート後も、昇順にならない状態です。
都道府県がA2:B48まで並んでいます。

    



    Dim s As Long, B As Variant, n As Long
    n = Cells(Rows.count, 4).End(xlUp).Row
    ReDim B(n - 2, 0)
    On Error GoTo myError
    For s = 2 To n
    
        B(s - 2, 0) = WorksheetFunction.VLookup(Cells(s, 4), Range("H2:I11"), 2, False)
    On Error Resume Next
    Next s
    
    Exit Sub
    
    

myError:
  
    MsgBox "エラー番号:" & Err.Number & vbCrLf & _
           "エラーの種類:" & Err.Description, vbExclamation

    Dim tmp As Variant '入れ替え時に一時的にデータを格納
    Dim min As Integer 'その時点での最小値が格納されるセルの行番号
    Dim k As Integer  '最新のソート対象行
    Dim m As Integer
    Dim i As Integer '繰り返しカウンタ
  
    '昇順にデータ整列
    'ソート対象行を最上位から最終行の手前まで進める
    For k = 2 To n

    
    '最小値格納行を初期化
        min = k
        
        For i = k + 1 To n + 1
            
         
            If Cells(min, 8).Value > Cells(i, 8).Value Then
                min = i
            End If
            
        Next i
        
        For m = 8 To 9
              
            tmp = Cells(k, m)
            Cells(k, m) = Cells(min, m)
            Cells(min, m) = tmp
        Next m
    
    Next k
   
   
End Sub


### 現状
現状配列に詰め出力範囲に詰めることができたのですが、昇順に並べ替えることができません。
私のコードですと配列B（）というのにデータがあるのですが、そこにあるデータをどのように取り出してコード後半にある選択ソートにはめ込めばいいかわかりません。

ちなみに、最初にFor k = 2 To nから下のコードを完成させ昇順に並べ替えることに成功しました。
しかし、WorksheetFunction.VLookupこちらを使い配列に詰めてから昇順にしたいのです。

よろしくお願いします。

Answer 1

Sub test()
    Dim rngList As Range        '一覧のセル範囲
    Dim rngKey As Range         '検索値のセル範囲
    Dim rngResults As Range     '結果を書き込むセル範囲
    Dim s As String             '数式で使う検索値の最初のセルアドレス
    
    With ActiveSheet
        Set rngList = .Range("A1").CurrentRegion
        With .Range("D1").CurrentRegion
            Set rngKey = Intersect(.Cells, .Offset(1))
        End With
        Set rngResults = rngKey.Offset(, 4).Resize(, 2)
    End With
    s = rngKey(1).Address(False, False)
    
    With rngResults
        .Columns(1).Formula = "=" & rngKey(1).Address(False, False)
        .Columns(2).Formula = "=Vlookup(" & s & "," & rngList.Address & ",2)"
        .Value = .Value
        .Sort .Cells(1), xlAscending, , , , , , xlNo
    End With
End Sub

ソートのアルゴリズムを勉強したいなら別ですが、
Excelを使うならエクセルのソート機能を使った方が、楽で速いです。

動作確認してません。書き間違いがあるかもです。

Comments

[退会済みユーザー]

回答ありがとうございます。
ソートアルゴリズムを勉強したくて、選択ソートで私は書いているんですが、Excelのソート機能というものを知らなかったのでそちらも勉強していきます。ありがとうございました。

Answer 2

実現したいことがよくわからなかったので、勘で書きました。

Sub Sample()
    Dim arrCode, arrPref
    
    Dim n
    n = Cells(Rows.Count, 4).End(xlUp).Row
    ReDim arrCode(n - 2, 0)
    ReDim arrPref(n - 2, 0)
    Dim s
    For s = 2 To n
        If Cells(s, 4) <> "" Then
            arrCode(s - 2, 0) = Cells(s, 4)
            arrPref(s - 2, 0) = WorksheetFunction.VLookup(Cells(s, 4), Range("A2:B48"), 2, False)
        End If
    Next
    
    Dim tmp As Variant '入れ替え時に一時的にデータを格納
    Dim min As Integer 'その時点での最小値が格納されるセルの行番号
    Dim k As Integer  '最新のソート対象行
    Dim m As Integer
    Dim i As Integer '繰り返しカウンタ
    
    For k = 0 To n - 3
        min = k
        For i = k + 1 To n - 2
            If arrCode(min, 0) > arrCode(i, 0) Then
                min = i
            End If
        Next i
        
        tmp = arrCode(k, 0)
        arrCode(k, 0) = arrCode(min, 0)
        arrCode(min, 0) = tmp
        tmp = arrPref(k, 0)
        arrPref(k, 0) = arrPref(min, 0)
        arrPref(min, 0) = tmp
    
    Next

    Dim r
    r = 2
    For k = 0 To n - 2
        If Not IsEmpty(arrCode(k, 0)) Then
            Cells(r, 8) = arrCode(k, 0)
            Cells(r, 9) = arrPref(k, 0)
            r = r + 1
        End If
    Next

End Sub

Comments

[退会済みユーザー]

回答ありがとうございます。
やはり、配列を二つ使ったほうが現実てきなのでしょうか？？
配列の中身を昇順のコードにはめ込む部分はjinojiさんのコードを参照させていただきます。
ありがとうございます！