1. Home » 
2. Excel講座の総目次 » 
3. Excel VBA入門：目次 » 
4. 配列を並べ替える

配列を並べ替える:Excel VBA入門

はじめに　　　　topへ

• Excelでは並べ替えにSortメソッドがあります。しかし、これはシートにデータが入力されている必要があります。
• 例えば、重複なしのデータを取り出して、昇順に並べ替えたい・・・という場合、一旦、重複なしのデータをシートに書き出して、Sortすることになると思います。
• これを、配列を並べ替えてシートへ書き出すようにしたいときは自分で並べ替えの処理を作成することになります。
  幸いなことに、並べ替えの処理については出版物やWebなどにいろいろな方法が紹介されています。
  ここでは、クイックソートという方法を利用してみます。
• クイックソートの考え方などアルゴリズムについてはご自身でお調べください。
  • 参考になると思われるサイト
    http://it.exinfo.biz/entry/post_11.html
    http://www2.starcat.ne.jp/~fussy/algo/algo5-4.htm
• 文字列データの比較方法はOption Compareステートメントで設定します。
  • 既定値はBinary モードです。バイナリ文字コードのコード順によって行われます。
    • Microsoft WIndows 版 Visual Basicでは 、文字コードはUnicodeで表現されるので、結果はUnicodeのコード順によって決まります。
    • バージョン4.0以前のWindows 16bit版 Visual Basic、またはMacintosh版 Visual Basicでは、文字コードはシフトJISで表現されていたため、結果が異なるようです。
  • Textモードでは日本語/日本(オペレーティング システムの国別情報の設定)の場合は、50音順で、大文字と小文字、文字幅、カタカナとひらがなを区別しない並べ替え順になります

クイックソート　　　topへ

• 以下のコードをサブルーチンとして使用します。昇順の並べ替えになります。
  • ｍｙData：並べ替える配列、L：配列の要素の下限、U：配列の要素の上限
    

    Sub Q_Sort(ByRef myData() As Variant, ByVal L As Long, ByVal U As Long) 　　Dim i As Long 　　Dim j As Long 　　Dim S As Variant 　　Dim Tmp As Variant 　　　　S = myData(Int((L + U) / 2)) 　　　　i = L 　　　　j = U 　　　　Do 　　　　　　Do While myData(i) < S 　　　　　　　　i = i + 1 　　　　　　Loop 　　　　　　Do While myData(j) > S 　　　　　　　　j = j - 1 　　　　　　Loop 　　　　　　If i >= j Then Exit Do 　　　　　　Tmp = myData(i) 　　　　　　myData(i) = myData(j) 　　　　　　myData(j) = Tmp 　　　　　　i = i + 1 　　　　　　j = j - 1 　　　Loop 　　　If (L < i - 1) Then Q_Sort myData, L, i - 1 　　　If (U > j + 1) Then Q_Sort myData, j + 1, U End Sub

• 降順にしたいなら、以下のように2か所を書き換えます。
  • Do While myData(i) > S
  • Do While myData(j) < S
• 実際に並べ替えてみましょう
  1. アクティブシートのA列に1〜10の乱数を20個入力します。
     

     Sub myRnd1() 　　Dim N As Double 　　Dim i As Long 　　Dim D 　　　　Const U = 20 　　　　ReDim D(1 To U, 1 To 1) 　　　　Randomize 　　　　For i = 1 To UBound(D) 　　　　　　N = Int(10 * Rnd + 1) 　　　　　　D(i, 1) = N 　　　　Next i 　　　　Sheets("Sheet1").Columns("A:A").ClearContents 　　　　Range("A1").Resize(UBound(D), 1).Value = D End Sub

  2. A列のデータを配列「myData」に読み込みます。これは2次元配列になっています。
     先のサブルーチンは1次元配列を使うようになっているので、1次元配列配列「X」に読み直します。
     Call Q_Sort(X, L, U)　でサブルーチンへ渡し、処理します。
     戻ってきた値を、2次元配列「S_Data」に読み込みなおして、B列へ入力しています。
     • 先のサブルーチン（1次元配列を使うコード）を流用しようという考えですので、わざわざ2次元配列を1次元配列に放り込んだりしています。
       2次元配列に対応したサブルーチンを作ればよいのに・・・という突っ込みはなし・・・ということでご了解ください。

     Sub Sort01() 　　Dim myData 　　Dim S_Data 　　Dim X() As Variant 　　Dim L As Long 　　Dim U As Long 　　Dim i As Long 　　　　myData = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp)).Value 　　　　ReDim X(1 To UBound(myData)) 　　　　For i = LBound(myData) To UBound(myData) 　　　　　　X(i) = myData(i, 1) 　　　　Next i 　　　　L = LBound(X) 　　　　U = UBound(X) 　　　　Call Q_Sort(X, L, U) 　　　　ReDim S_Data(1 To U, 1 To 1) 　　　　For i = L To U 　　　　　　S_Data(i, 1) = X(i) 　　　　Next 　　　　Range("B:B").ClearContents 　　　　Range("B1").Resize(UBound(S_Data), 1).Value = S_Data End Sub

  3. 実行後の画面です。
     A列が乱数で入力したデータになります。並べ替えた結果がB列です。
     

Dictionaryと組み合わせる　　　topへ

• 上記のように重複する値がある場合は、重複なしで並べたいと思います。
  Dictionaryを利用し、以下のようにしてみました。
  • Dictionary関連は赤文字の部分です。
  • コード例
    

    Sub Q_D_Sort() 　　Dim myData 　　Dim S_Data 　　Dim myDic As Object 　　Dim X() As Variant 　　Dim D As Variant 　　Dim L As Long 　　Dim U As Long 　　Dim i As Long 　　　　myData = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp)).Value 　　　　’----重複なしの値をDictionaryで取り出す 　　　　Set myDic = CreateObject("Scripting.Dictionary") 　　　　For Each D In myData 　　　　　　If Not D = Empty Then 　　　　　　　　If Not myDic.Exists(D) Then 　　　　　　　　　　myDic.Add D, "" 　　　　　　　　End If 　　　　　　End If 　　　　Next D 　　　　X = myDic.keys 　　　　Set myDic = Nothing 　　　　’----Q_Sortで並べ替える 　　　　L = LBound(X) 　　　　U = UBound(X) 　　　　Call Q_Sort(X, L, U) 　　　　ReDim S_Data(1 To U + 1, 1 To 1) 　　　　For i = L To U 　　　　　　S_Data(i + 1, 1) = X(i) 　　　　Next 　　　　Range("B:B").ClearContents 　　　　Range("B1").Resize(UBound(S_Data), 1).Value = S_Data End Sub

• 重複なしで並べ替えができました。
  

スポンサードリンク

PageViewCounter
　
　Since2006/2/27