実践!エクセルVBAでクイックソートを使う

エクセルでは簡単にデータをシート上でソートできるが、VBAで配列をソートしようとするとプログラムを書く必要がある。もちろんシートに書き出して、エクセルの機能でソートして、また配列に戻すと言う面倒なこともできるが、速度的にもプログラム的にも配列をそのままソートできたほうが便利だ。ここでは高速に2次元配列をソートできるクイックソートを紹介する。

まずエクセルのソート機能を見てみよう。日時順に並んでいるデータを住所をキーとして並べ替えしてみる。

excelvbasort001

excelvbasort002

エクセルは標準で読み方でソートするので日本語入力でソートするとこのような結果になる。標準機能だけあって処理は高速だ。これと同等のことをVBAで配列を使ってやってみるのが今回の記事である。

ではVBAでのクイックソートのプログラムであるが、すでにいくつものサンプルプログラムがネット上で公開されているので必要ないと思ったが、コメントをつけたので参考にしていただければと思う。参照したのはエクセルの真髄さんの2次元配列のクイックソートである。

過去に紹介している実践!エクセルVBAで配列を使いこなすの2次元配列をそのままソートして利用することができる。

まずはクイックソート関数を適当なモジュールに作成する。

'-- クイックソート --
Public Sub ArraySort(ByRef data() As Variant, Min As Variant, _
Max As Variant, key As Integer)

    Dim i As Double                        'ループ変数
    Dim j As Double                        'ループ変数
    Dim k As Double                        'ループ変数

    Dim R As Variant                       '基準値変数
    Dim S As Variant                       '入れ替え変数

    R = data(Int((Min + Max) / 2), key)    '基準値
        i = Min                            '初期値i
        j = Max                            '初期値j

    Do
        Do While data(i, key) < R          '基準より小さいとき
            i = i + 1                      'iをプラス1
    Loop
    Do While data(j, key) > R              '基準より大きいとき
            j = j - 1                      'jをマイナス1
    Loop
    If i >= j Then Exit Do                 'iがj以上になったらループを抜ける
        For k = LBound(data, 2) To UBound(data, 2) '行全体を移動
           S = data(i, k)                  '入れ替え元の値を記憶
           data(i, k) = data(j, k)         '入れ替え元へ入れ替え先のデータを入れる
           data(j, k) = S                  '入れ替え先へ入れ替え元の値を入れる
        Next
        i = i + 1
        j = j - 1
    Loop

    If (Min < i - 1) Then
        Call ArraySort(data, Min, i - 1, key)
    End If
    If (Max > j + 1) Then
        Call ArraySort(data, j + 1, Max, key)
    End If
End Sub

使い方としてはメインフローで

Call ArraySort(data, 2, 1000, 2)

のようにして呼び出す。引数の「data」は2次元配列、次の「2」はデータの始まる行(1行目はタイトルが入っていることが多いので2行目からソート対象に入れる)、次の「1000」はデータの終わる行(通常は可変であると思われるので事前に行数を把握しておく)、次の「2」は2列目をソートするキーとして指定している。

実際に最初のシートをソートしてみるプログラムを書いてみる。Sheet2Array関数(シートを丸ごと配列に入れる)、GetArrayInfo関数(配列の次元数や有効要素情報を取得)、Array2Sheet関数(配列を丸ごとシートに貼り付ける)は実践!エクセルVBAで配列を使いこなすで紹介した自作の関数である。事前にモジュールに追加しておこう。これを使えば下記のようなすっきりとしたプログラムになる。

元のデータはSheet3に記入している。また、出力先もSheet5にしているので実行前にシートを追加して環境をあわせておこう。

Sub main()
'入力
Dim data() As Variant                           'データを入れる配列を定義
data = Sheet2Array(ThisWorkbook.Name, "Sheet3") 'Sheet3シートを配列化

Dim AItem() As Variant
Call GetArrayInfo(data, AItem)          'dataの有効要素数を取得(戻り値で次元数も取得できる)
Call ArraySort(data, 2, AItem(1), 2)    'data配列の2行目から最終行まで2列目をキーに昇順ソート

'出力
Call Array2Sheet(data, ThisWorkbook.Name, "Sheet5")  'Sheet5シートにdata配列を出力
End Sub

実行するとSheet3のデータを読み取って、GetArrayInfoで有効要素数を取得している。これでデータ数が増えても対応できる。そして先ほどのソートをして、Sheet5にソートした結果を出力している。data配列はByRef指定しているのでそのまま中身がソートされることになる。もし、最初のデータを残しておきたい場合は、先に配列をコピーするなどの処理を入れておく。

では結果のSheet5を見てみる。

excelvbasort003

先ほどのエクセルのソートとは異なる結果になると気づいた方もいるだろう。ただ、順番は違うが、同じ住所はまとまっているのでソートとしては正常に動いているとわかる。では何を基準にソートしているかと言うと、環境によっても異なるかもしれないが、通常はアスキーコード順になる。文字をアスキーコードの数字に置き換えて大小比較しているというわけだ。もし狙った順番にしたいという方は数字を使うことをおすすめする。文字のコードが気になる方はVBAのプログラムでAscW(文字列)で値をとってみるとわかりやすいだろう。

今回のはデータ数が少ないので参考にならないかもしれないが、入力から出力まで0.01秒程度である。クイックソートと言うだけあって高速である。ちなみに上記のデータを6万データほど用意しても私の環境だと1秒未満で完了する。

以上で2次元配列のソートができた。さらにキーを複数にしてソートすることも工夫次第で可能である。

例えば住所と市区町村でを合わせた文字列でソートしたい場合、ソートするデータに住所と市区町村を結合したものを作成する。ここでは新規にdata2という配列を作成し、1~3列目はdata配列と同じものをいれて、4列目に2列目と4列目の文字列を繋げたものを入れる。先ほどのプログラムのソートする前に入れるという感じだ。

Dim data2(1 To 100000, 1 To 4)
Dim j As Double
For j = 1 To AItem(1)
    data2(j, 1) = data(j, 1)
    data2(j, 2) = data(j, 2)
    data2(j, 3) = data(j, 3)
    data2(j, 4) = data(j, 2) & Space(40 - LenB(data(j, 2))) & _
    data(j, 3)
Next
Call ArraySort(data2, 2, AItem(1), 4)                            '4列目をキー

プログラムで書くとこんな感じになる。配列の大きさを変えれるのであればRedimを使っても良いかもしれないが、今回は配列コピーのような手法を使った。最後の出力でdata2をSheet5にすると結果が見れる。

excelvbasort004

4列目がキーとして使用した文字列になる。工夫しているのが結合する2つ目のキーの頭を揃えているところである。LenBで文字列のバイト数をカウントして40から引いた数をスペースとして入れている。(日本語は2byte)これで全部で半角で40文字となり、桁数が合う。2つ目のキーの市区町村の始まり位置が一致しているのがわかると思う。

なぜ揃えるかというと比較する際に先頭の文字から見ていくわけだが、合っていないとうまくソートしない場合があるからだ。数字だとわかりやすいので2つの値を結合してキーとする場合、

1100 & 6000 → 11006000
11005 & 7000  → 110057000

頭から比較していくと1100は同じで差がなく、次の文字で大小が決まる。結合した文字列だと2つ目のほうが5なので小さくなり、昇順ソートでは上に来てしまう。結合する前では上に書いたとおりの順番になるはずが結合したものをキーにすることによって予期しない入れ替わりが起こってしまう。そこでスペースを入れてやると

1100 & 6000 → 1100   6000
11005 & 7000 → 11005 7000

5とスペースの比較になりスペースのほうが文字コード順としては小さいので昇順ソートで上に来る。これで正常なソートができるわけだ。(スペースは数字よりも小さい文字コードが返ってくる)

文字や数字の比較ではこれでOKであるが、日時だともう少しややこしい。データベースなどから取得した日付がString型になっていた場合だ。

2015/1/1 1:30:21
2015/1/1 15:30:21

の場合、どちらが昇順ソートすると上に来るかというと、15:30の方である。頭から文字列を比較していくと、「2015/1/1 1」までは一緒であるが次が「: コロン」と「5」の比較になる。どちらが大きいアスキーコードを返すかと言うと、コロンの方で、日時通りに並ばず入れ替わるということが起きる。

ではどうするかと言うと、「文字型→日付型」、「日付型→Double型」、「Double型→文字型」とすればうまくいくはずである。最終的に文字型に戻しているのは2つのキーを使うときに結合できるようにである。

プログラム見ていくと、下記のようになる。

Debug.Print CDate("2015/1/1 10:15")
Debug.Print CDbl(CDate("2015/1/1 10:15"))
Debug.Print CStr(CDbl(CDate("2015/1/1 10:15")))

'結果
'2015/01/01 10:15:00            日付型になっている
'42005.4270833333        Double型になっている(シリアル値になる)
'42005.4270833333        文字型になっている(見た目は変わらない)

エクセルで見ていると、どこが何型なのかわかりにくいことがあるので注意が必要である。セルに日付が入っているからといってそれが日付型なのか、文字型なのか見分ける必要がある。ソートする時に比較する型が一致していればわざわざ型変換する必要はないが、2つのキーを使いたい場合は文字型で結合することになると思うので、最終的には文字型で桁数を合わせて比較ということになる。

配列とクイックソートが使えるようになれば大体のデータ処理は出来るようになるだろう。

コメント

  1. […] 実践!エクセルVBAでクイックソートを使う […]

  2. […] さらに、実践!エクセルVBAでクイックソートを使うを読んでいただけると大体のデータ処理が出来るようになるだろう。 […]

  3. CBR より:

    大変参考になる情報、ありがとうございます。
    ご質問なのですが、並替処理した出力結果を、シート全体ではなく特定の部分(B4以降等)に書き出したい場合どのように指定すればよいでしょうか?

    • kazutomo より:

      コメントありがとうございます。参考になったようでよかったです。まさかこんな記事にコメントがつくとは予想外でした^^

      質問の内容ですが、汎用性がないので個別に書いたほうがいいですね。ちょっとコメント欄でプログラムは見にくいですが・・・

      With Workbooks(ブック名).Sheets(シート名)
      .Range(.Cells(4, 2), .Cells(4+ソートした配列の行数,2+ソートした配列の列数 )) = ソートした配列
      End With

      で、いけると思います。貼り付けるRangeをセルで指定してやればいいと思います。B4であればセルで言うとCell(4,2)になります。

      例えば・・・
      ブック名 book1
      シート名 Sheet3
      ソートした配列 data
      ソートした配列の行数 30
      ソートした配列の列数 2
      開始位置 B4

      With Workbooks(“book1”).Sheets(“Sheet3”)
      .Range(.Cells(4, 2), .Cells(4+30,2+2)) = data
      End With

      という感じになると思います。(確認していないので動かなかったらすみません)

  4. 通りすがり より:

    このサイトは全部,整数をintegerやlongではなくdouble宣言推しですか?

  5. ぐだぐだ@ひらひら より:

    有用なスクリプトを公開していただいてありがとうございます。
    クイックソート モジュールの17行目のコメントにソース部分が取り込まれて無限ループに陥る状態になっているようです。
    分離してみたらきちんと動作するようになりましたので、多分ですが…。

    • kazutomo より:

      書き込みありがとうございます。報告ありがとうございます。

      本当ですね。コメントにプログラムが入ってしまっていました。気づかなかったです(^^;公開当時からきっとこの状態だったと思います。誰も気にしてなかったんですかね・・・

      修正しましたので、よろしくお願いいたします。

      • ぐだぐだ@ひらひら より:

        確認いただきまして、ありがとうございます。
        皆さん、動かしてみないんでしょうか?
        わたしはとりあえず、動かしてみてから、自分好みにアレンジしていくタイプなので、動いてくれないと泣きが入りますw
        コピペだけして、動かなかったら、他のを探すのでしょうかね(^_^;
        なんか、もったいない感じです。
        動くようにしてこそ、良い経験だと思うんですけどね(^_^;

        いずれにしろ、どうもありがとうございました。

タイトルとURLをコピーしました