« 2つの文字列を比較する関数 StrComp() | トップページ | ぐーぐる検索用の右クリックマクロ(プログラム文の最適化) »

2010年1月17日 (日)

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

以前紹介した【改良】クイックソートを用いてアルファベットの文字列を並び替えをさらに改良しました。

▼前回からの改良点
文字列の比較方法を簡略化したため、処理速度が若干向上しました。

2155個の英単語を並び替える場合で比べると、
 前回: 27秒
 今回: 23秒
となりました。

期待していたほどは、減りませんでした。。。

ただ、プログラム文が16%ほど減った(61行→51行)ので、私は満足しています。

▼具体的な改良方法
アルファベットの大文字・小文字や平仮名・カタカナを区別せずに
同じものとして比較できる関数を発見しました。

前回紹介したStrComp()です。

これを用いると、「ABCE」と「abce」や「あいうえお」と「アイウエオ」を
同じものとして比較して並び替えることができます。

前回のプログラムでは、大文字と小文字の英字の区別をなくすために
Asc関数を用いました。

つまり、A と a とを同じものと認識させるために、それぞれの
Asc関数の値を変換して比較しました。苦肉の策でしたね。

▼留意点
今回は、数字の半角・全角も同じものとして比較するため、
前回とは並べ替え後の順序が変わりました。

並び替え前

並べ替え後

【前回プログラム】

並べ替え後

【今回プログラム】

300

1500

150

情報

お気に入り

1500

便利

お得

300

お役立ち

お買い物

50

販売

お役立ち

blog

通販

アニメ

book

blog

ショッピング

design

通信販売

デパート

DVD

Shopping

ニュース

FC2

Shop

ブログ

Free

50

ホテル

free book

ヤフー

ヤフー

Search

通信 販売

映画

Shop

通信 販売

検索

Shopping

ブログ

SNS

1500

情報

tool

150

進学塾

web

お気に入り

中学受験

web2.0

通信 販売

アニメ

お買い物

通信販売

お気に入り

検索

通信 販売

お得

お得

通販

お買い物

デパート

販売

お役立ち

web

便利

ショッピング

Free

無料

デパート

web2.0

予備校

ニュース

tool

150

ブログ

無料

300

ホテル

book

50

ヤフー

free book

blog

映画

ニュース

book

検索

進学塾

design

design

DVD

情報

Search

FC2

進学塾

中学受験

Free

中学受験

アニメ

free book

通信 販売

ショッピング

Search

通信 販売

SNS

Shop

通信販売

映画

Shopping

通販

FC2

SNS

販売

ホテル

tool

便利

DVD

web

無料

予備校

web2.0

予備校

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

      Dim pCnt As Integer '段落数用の数値
      Dim pCntMax As Integer '段落の最大値
      Dim i As Long    '並び替え用の数値
      Dim j As Long    '並び替え用の数値
      Dim swap As String  '並び替え時の仮置き用変数
      Dim Chara() As String  '文字列
      Dim nMax As Integer '最大文字数
      Dim n As Integer    '比較する文字の序数
      Dim BlnSwap As Boolean '変更するか否かを示す
      Dim actDoc As Document '文書
      Dim StartT, FinishT, TotalT As Long  '時間計測用

10    StartT = Timer

20    Set actDoc = ActiveDocument

      '参照符号一覧の段落数
30    pCntMax = actDoc.Paragraphs.Count
40    ReDim Chara(1 To pCntMax)

      '文字列の読み込み
50    For pCnt = 1 To pCntMax
60        With actDoc.Paragraphs(pCnt).Range
70            Chara(pCnt) = Left(.text, .Characters.Count - 1)
80        End With
90    Next pCnt

      'ソート開始
100   For i = 1 To pCntMax

110       For j = pCntMax To i Step -1
         
              '文字の大小の比較の最大回数を算出
              '少ない文字数を最大回数とする
             
120           If Len(Chara(i)) > Len(Chara(j)) Then
130               nMax = Len(Chara(j))
140               BlnSwap = True
150           Else
160               nMax = Len(Chara(i))
170               BlnSwap = False
180           End If

              'n文字目のアルファベットの比較
190           For n = 1 To nMax
                                     
                  'Chara(i)のn文字目がChara(j)のn文字目より大きい場合
200               If StrComp(Mid(Chara(i), n), Mid(Chara(j), n), vbTextCompare) = 1 Then
                  '順番を入れ替える
210                   swap = Chara(i)
220                   Chara(i) = Chara(j)
230                   Chara(j) = swap
240                   Exit For
                  
                  'Chara(i)がChara(j)より小さい場合
250               ElseIf StrComp(Mid(Chara(i), n), Mid(Chara(j), n), vbTextCompare) = -1 Then
                  '順番を入れ替えない
260                   Exit For
                  
                  'Chara(i)とChara(j)が同じ場合 かつ
                  'nが比較を繰り返す最大回数nMaxになっても
                  '文字の大小の比較が終わっていない場合
270               ElseIf StrComp(Mid(Chara(i), n), Mid(Chara(j), n), vbTextCompare) = 0 And n = nMax Then
                  
                      'Chara(i)の文字数がChara(j)の文字数より多い場合
280                   If BlnSwap = True Then
290                       swap = Chara(i)
300                       Chara(i) = Chara(j)
310                       Chara(j) = swap
320                       Exit For
                  
                      'Chara(i)の文字数がChara(j)の文字数以下の場合
330                   Else
340                       Exit For
350                   End If
                  
360               End If
             
370           Next n
             
380       Next j

390   Next i

      '並び替え後を表示

400   With actDoc
410       .Range(.Range.End - 1, .Range.End - 1).InsertParagraphAfter
420       .Range(.Range.End - 1, .Range.End - 1).text = "【並び替え後】"
430       .Range(.Range.End - 1, .Range.End - 1).InsertParagraphAfter

440       For i = 1 To pCntMax
450           .Range(.Range.End - 1, .Range.End - 1).text = Chara(i)
460           .Range(.Range.End - 1, .Range.End - 1).InsertParagraphAfter
470       Next i
480   End With

490   FinishT = Timer
500   TotalT = FinishT - StartT

510   msgbox TotalT & "秒かかりました。"

End Sub

|

« 2つの文字列を比較する関数 StrComp() | トップページ | ぐーぐる検索用の右クリックマクロ(プログラム文の最適化) »

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

コメント

コメントを書く



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




トラックバック

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

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

« 2つの文字列を比較する関数 StrComp() | トップページ | ぐーぐる検索用の右クリックマクロ(プログラム文の最適化) »