« 【再再改良】フォルダ中のすべてのワードファイルの内容をコピペする | トップページ | 【改良】クイックソートを用いてアルファベットの文字列を並び替え »

2009年11月21日 (土)

クイックソートを用いてアルファベットの文字列を並び替え

こちらに改良版を紹介しています。ご覧ください。

プログラム業界では、クイックソートという考え方があるそうです。

今回紹介するプログラムは、クイックソートを利用した
アルファベットの並び替えの例です。

▼背景
リストボックスに書かれた文字列をアルファベット順に並び替えるための
サンプルマクロを探していたら「クイックソート」という言葉に出会いました。

Excel VBA 実用サンプルコレクション」の407ページに
言葉だけ書かれており、ネットで検索しました。

リストボックスの文字列を並び替える場合には、
一旦リストボックスに書かれた配列を取り出して
並び替えた後に、再度リストボックスに書き込む
プログラムにします。

以下のサンプルでは、Chara()という配列が
10行から100行にて定義されています。

▼参考にしたページ
エクセルVBAの書籍をたくさん書かれており、また
セミナーも行っている田中亨さんのOffice Tanakaです。

「クイックソート」で検索すると様々なページがありましたが、
このページに書かれたコードが短くて美しいと思ったので参考にしました。

また、クイックソート以外にも、VBAに関する情報がたくさん載って
いますので、非常に役に立つサイトだと思います。

▼並び替え結果例
【並び替え前】
apple
people
connector
3
an
condition
Ai
third
200
a

【並び替え後】
200
3
Ai
a
an
apple
condition
connector
people
third

▼工夫
アルファベットの大小を比較するために、アスキーコード
にて大きさを比較しました。

170行~300行にて、2文字目までを比較するようにしました。

そのために、上記の例の通り、3文字目以降から文字がかわる
conditionとconnectorとは、正確に並び替えることができません。

また、アスキーコードの場合には、大文字と小文字とで
別々の数値が指定されているので、それも考慮した方が
よりよい並び替えになりますね。

もっと簡単な考え方をご存じの方がいらっしゃったら
教えてください。

▼プログラム
Sub QuickSortの例()

      Dim i As Long    '並び替え用の数値
      Dim j As Long    '並び替え用の数値
      Dim msg As String  'メッセージ
      Dim swap As String  '並び替え時の仮置き用変数
      Dim Chara(1 To 10) As String  '文字列

10    Chara(1) = "apple"
20    Chara(2) = "people"
30    Chara(3) = "connector"
40    Chara(4) = "3"
50    Chara(5) = "an"
60    Chara(6) = "condition"
70    Chara(7) = "ai"
80    Chara(8) = "third"
90    Chara(9) = "200"
100   Chara(10) = "a"

      'ソート前の文字列を取得
110   msg = msg & "【並び替え前】" & vbCrLf

120   For i = 1 To 10
130       msg = msg & Chara(i) & vbCrLf
140   Next i

      'ソート開始
150   For i = 1 To 10

160       For j = 10 To i Step -1
               
               '1文字目が同じアルファベットだったとき
170            If String(1, Chara(i)) = String(1, Chara(j)) Then
                  
                  '2文字目の比較(ケース1)
180               If Mid(Chara(i), 2) <> vbNullString And _
                     Mid(Chara(j), 2) <> vbNullString Then
190                   If String(1, Mid(Chara(i), 2)) > String(1, Mid(Chara(j), 2)) Then
200                       swap = Chara(i)
210                       Chara(i) = Chara(j)
220                       Chara(j) = swap
230                   End If
240               End If
                  
                  '2文字目の比較(ケース2)
250               If Mid(Chara(i), 2) <> vbNullString And _
                     Mid(Chara(j), 2) = vbNullString Then
260                   swap = Chara(i)
270                   Chara(i) = Chara(j)
280                   Chara(j) = swap
290               End If

300           End If
             
              '1文字目が違うアルファベットの時
310           If String(1, Chara(i)) > String(1, Chara(j)) Then
320               swap = Chara(i)
330               Chara(i) = Chara(j)
340               Chara(j) = swap
350           End If
             
360       Next j
370   Next i

      'ソート後の文字列を取得
380   msg = msg & "【並び替え後】" & vbCrLf
390   For i = 1 To 10
400       msg = msg & Chara(i) & vbCrLf
410   Next i

      '結果を表示
420   msgbox msg

End Sub

|

« 【再再改良】フォルダ中のすべてのワードファイルの内容をコピペする | トップページ | 【改良】クイックソートを用いてアルファベットの文字列を並び替え »

マクロプログラム」カテゴリの記事

コメント

コメントを書く



(ウェブ上には掲載しません)




トラックバック

この記事のトラックバックURL:
http://app.cocolog-nifty.com/t/trackback/519619/46823676

この記事へのトラックバック一覧です: クイックソートを用いてアルファベットの文字列を並び替え:

« 【再再改良】フォルダ中のすべてのワードファイルの内容をコピペする | トップページ | 【改良】クイックソートを用いてアルファベットの文字列を並び替え »