VBA

【VBA】マージソートを活用した配列内の並び替え2（文字列ver.）コピペOK

  /
記事内に商品プロモーションを含む場合があります

このページでわかること

VBAの配列において、文字列の要素を並び替えるプログラムを作成しました。
マージソートのアルゴリズムを活用しています。
文字列の比較にstrComp関数を利用しています。
関数化しているのでコピペOK

こんにちは、hokkyokunです。

配列内ソートの関数を作成し、ブログで公開しました。
こちらにありますので、よかったら見てください。
一方、作成したプログラムは数値と日付限定となっており、
文字列には対応していませんでした。

今回は
strComp関数とマージソートを応用して
文字列ソートプログラムを作成しました。

Contents
  1. マージソートとは
  2. 事前知識（strComp関数）
  3. 関数（コピペOK）
  4. 関数の使用例
  5. おまけ（文字列の優先順位）

マージソートとは

マージソートはアルゴリズムの一種で
処理工程を大幅に削減しながら、配列の並び替えをすることができます。

詳細はこちらを見ていただきたいのですが、
大まかにいうと、

  1. 配列を二分割　⇒　これを繰り返す
  2. 二分割した配列を比較、小さい順（または大きい順）に結合する
    ⇒　最終的に全部結合して一つの配列に戻す

2.ですが、
文字列の比較にはstrComp関数を使用します。

事前知識（strComp関数）

文字列の比較にはstrComp関数を使用すると便利です。
これは、引数に文字列２つ渡し、それらを比較する関数です。

構文説明

構文

StrComp(string1, string2, [ compare ])


string1 : 比較する文字列1。省略不可
string2 : 比較する文字列２。省略不可
compare : string1,string2を比較するモードを選択。省略可。

compareの定数とその内容の説明を以下の表に示します。
全角半角などを比較したい場合は　「vbBinaryCompare」
そうじゃない場合は　「vbTextCompare」を使用します。

定数値説明
vbBinaryCompare0バイナリ比較を実行します。
大文字小文字、全角半角、ひらがなカタカナを違うものとして判定します。
vbTextCompare1テキスト比較を実行します。
大文字小文字、全角半角、ひらがなカタカナは同一として判定します。
vbDatabaseCompare2Microsoft Access のみ。 データベース内の情報に基づいて比較を実行します。

string1と2を比較した結果は数値として返ってきます。
下記に対応表を示します。

string1 、 string2 の比較戻り値
string1 ＜ string2 -1
string1 ＝ string2 0
string1 ＞ string2 1
string1 または string2 が Null であるNull

使用例

実際にいくつか試してみました。

例結果
（戻り値）		備考大文字小文字
全角半角
かなカナ
strComp(“a”,”a”,vbBinaryCompare)0“a” = “a”比較する
strComp(“a”,”A”,vbBinaryCompare)1“a” > “A”比較する
strComp(“a”,”A”,vbTextCompare)0“a” = “A”比較しない
strComp(“ab”,”a”,vbBinaryCompare)1“ab” > “a”比較する
strComp(“あ”,”あい”,vbBinaryCompare)-1“あ” < “あい”比較する
strComp(“あ”,”ア”,vbBinaryCompare)-1“あ” < “ア”比較する
strComp(“1″,”a”,vbBinaryCompare)-1“1” < “a”比較する

関数（コピペOK）

お待たせしました。文字列をソートする関数です。

そのまま使ってもらって大丈夫です。
作りは、数値、日付用で作ったマージソート関数と基本的に同じです。

変えたのは５７行目と71行目の
分割した配列間の比較を
strComp関数を使ったことです。

引数の使い方
引数は二つあります。どちらも指定をしてください。
第一引数　⇒　ソート前の配列
第二引数　⇒　昇順降順を指定（昇順＝True,　降順＝False）

使用上の注意

strComp関数で比較しているので数値は強制的に文字列扱いになります。
この関数は文字列の比較として使用してください。 

Function merge_Sort_for_strComp(arrs As Variant, asc As Boolean)
    '配列を二分割する。左(Larrs)と右(Rarrs)で便宜上命名
    Dim Larrs(), Rarrs() As Variant
    Dim m As Long '配列の真ん中を整数で取得
    Dim i As Long '二分割した後の配列(Larrs,Rarrs)に格納するためのインデックス
    Dim Li As Long 'Larrsに格納する値をarrsで指定するためのインデックス
    Dim Ri As Long 'Rarrsに格納する値をarrsで指定するためのインデックス
    
    If UBound(arrs) <= 0 Then
        '分割前の配列が最大要素が0以下(=要素数1以下)になったら終了
        '再帰関数の出口＝これがないと多分エラーで止まる(か、無限ループ？）
        merge_Sort_for_strComp = arrs
    Else
        '要素数を2で割った商を1引く
        m = (UBound(arrs) + 1) \ 2 - 1
        
        '元の配列(arrs)の要素から、0～m(要素数の真ん中)までの要素をLarrsに格納
        i = 0
        For Li = 0 To m
            ReDim Preserve Larrs(i)
            Larrs(i) = arrs(Li)
            i = i + 1
        Next Li
        
        '元の配列(arrs)の要素から、m+1～最後までの要素をRarrsに格納
        i = 0
        For Ri = m + 1 To UBound(arrs)
            ReDim Preserve Rarrs(i)
            Rarrs(i) = arrs(Ri)
            i = i + 1
        Next Ri
        
        '再帰処理
        Larrs = merge_Sort_for_strComp(Larrs, asc)
        Rarrs = merge_Sort_for_strComp(Rarrs, asc)
        merge_Sort_for_strComp = merge_for_strComp(Larrs, Rarrs, asc)
    End If
End Function

Function merge_for_strComp(Larrs As Variant, Rarrs As Variant, asc As Variant)
    Dim Li As Long '左側の配列(Larrs)のインデックス
    Dim Ri As Long '右側の配列(Rarrs)のインデックス
    Dim Ai As Long '結合後の配列のインデックス
    Dim arrs() As Variant '結合後の配列
    Dim str As String '結合後の配列に格納する要素を入れる
    Dim i As Long '残っている要素を一気に格納するためのインデックス

    '結合するために二つの配列を用意する。
    '便宜上、左側の配列（以下Larrs)と右側の配列(以下Rarrs)と命名する。
    'LarrsとRarrsの要素を比較し、小さいものを結合後の配列(以下arrs)に格納する
    
    'LarrsとRarrsの要素どちらも残っている場合、
    '要素を比較して小さい方をarrsに格納する。
    '入れた方の配列はインデックスを＋1する。
    
    If asc = True Then
        Do While (Li <= UBound(Larrs)) And (Ri <= UBound(Rarrs))
            If StrComp(Larrs(Li), Rarrs(Ri)) >= 0 Then
                str = Rarrs(Ri)
                Ri = Ri + 1
            Else
                str = Larrs(Li)
                Li = Li + 1
            End If
    
            ReDim Preserve arrs(Ai)
            arrs(Ai) = str
            Ai = Ai + 1
        Loop
    Else
        Do While (Li <= UBound(Larrs)) And (Ri <= UBound(Rarrs))
            If StrComp(Larrs(Li), Rarrs(Ri)) <= 0 Then
                str = Rarrs(Ri)
                Ri = Ri + 1
            Else
                str = Larrs(Li)
                Li = Li + 1
            End If
    
            ReDim Preserve arrs(Ai)
            arrs(Ai) = str
            Ai = Ai + 1
        Loop
    End If

    'Larrsに要素が残っていたら、処理
    If Li <> UBound(Larrs) + 1 Then
        For i = Li To UBound(Larrs)
            ReDim Preserve arrs(Ai)
            arrs(Ai) = Larrs(i)
            Ai = Ai + 1
        Next i
    End If

    'Rarrsに要素が残っていたら、処理
    If Ri <> UBound(Rarrs) + 1 Then
        For i = Ri To UBound(Rarrs)
            ReDim Preserve arrs(Ai)
            arrs(Ai) = Rarrs(i)
            Ai = Ai + 1
        Next i
    End If

    merge_for_strComp = arrs
End Function

関数の使用例

上記の関数を実際に使ってみました。

Sub test()
    Dim arrs As Variant 'ソート前の配列
    Dim results As Variant 'ソートをした後の配列
    
    arrs = Array("a", "e", "d", "c", "b")
    results = merge_Sort_for_strComp(arrs, True)
    Stop
End Sub

結果です。

おまけ（文字列の優先順位）

いろいろな文字列の種類で実際に試してみました。
[“Ａ”, “ｱｲ”, “a”, “aa”, “aBC”, “abc”, “あ”, “あい”, “A”, “ABC”, “愛”, “相”, “アイ”, “あお”]
なんとなく、ソートが難しそうなものをかけてみました。

Sub test2()
    Dim arrs As Variant 'ソート前の配列
    Dim results As Variant 'ソートをした後の配列
    
    arrs = Array("Ａ", "ｱｲ", "a", "aa", "aBC", "abc", "あ", "あい", "A", "ABC", "愛", "相", "アイ", "あお")
    results = merge_Sort_for_strComp(arrs, True)
    Stop
End Sub

結果としてはこんな感じでした。

文字列の比較ができました。
マージソートのアルゴリズムを理解しておくことで
簡単に応用することができました。基礎ってやっぱり大事。

一方で、数値、日付の場合と文字列の場合で使い分けするのは面倒なので、
数値と文字列どちらでも対応できる関数を作ってみたいと思います。

できたら、また記事を書きたいと思いますので、
よろしくお願いいたします。

ではでは。

RELATED POST