Interface で コンパレータを実装する。

Interface で コンパレータを実装する。

クラス内のSortコマンドのソート順を変えたいケースが出てきました。
ソート方法を変更するパターンとして Java や C# でコンパレータを利用するパターンがあります。
それをVBAで実現してみた。と、いっても Object でもできちゃうのでアレですが Interface 好きなので。
(なお、この例ではクラス内のSortではなく、標準モジュールに書いています。念のため)

インターフェースの実装(IComparerクラス)

通常インタフェースの中身は必要ありませんが、規定の比較方法として後で使用します。

Option Explicit

Public Function Compare(ByVal v1 As Variant, ByVal v2 As Variant) As Long
    
    'defaultの比較方法
    Select Case v1
        Case Is > v2
            Compare = 1
        Case Is < v2
            Compare = -1
        Case Is = v2
            Compare = 0
    End Select

End Function

比較方法の中身を入れ替えるコンパレータ実装(ExplorerComparerクラス)

比較方法としてExplorerの比較方法をソートに導入します。

Option Explicit
Implements IComparer
Private Declare PtrSafe Function StrCmpLogicalW Lib "Shlwapi" (ByVal psz1 As LongPtr, ByVal psz2 As LongPtr) As Long

'Explorer と同様の比較を行うコンパレータ
Private Function IComparer_compare(ByVal v1 As Variant, ByVal v2 As Variant) As Long
    
    IComparer_compare = StrCmpLogicalW(StrPtr(CStr(v1)), StrPtr(CStr(v2)))

End Function

呼び出しサンプル

ソートの引数でコンパレータが指定されたときにその内容を使用してソートをします。
指定されなかった場合、IComparer クラス内に記述されて規定の比較方法でソートするようにします。

Option Explicit
Private mCol As Collection
'--------------------------------------------------------------
'  コレクションのソート
'--------------------------------------------------------------
Private Sub Sort(Optional ByVal CP As IComparer = Nothing)

    Dim i As Long
    Dim j As Long
    Dim col2 As Collection
    Dim blnFind As Boolean
    
    If CP Is Nothing Then
        'Interfaceも普通のクラスなのでDefault比較として利用
        Set CP = New IComparer
    End If
    
    'Collectionが空ならなにもしない
    If mCol Is Nothing Then
        Exit Sub
    End If

    'Collectionの要素数が0または1の場合ソート不要
    If mCol.Count <= 1 Then
        Exit Sub
    End If
    
    Set col2 = New Collection
    
    For i = 1 To mCol.Count
        If col2.Count = 0 Then
            col2.Add mCol(i)
        Else
            blnFind = False
            For j = col2.Count To 1 Step -1
    
                '元コレクションの方が大きかった場合、その後に挿入。
                If CP.Compare(mCol(i), col2(j)) >= 0 Then
                    col2.Add mCol(i), , , j
                    blnFind = True
                    Exit For
                End If
            Next
            If Not blnFind Then
                col2.Add mCol(i), , 1
            End If
        End If
    
    Next
    
    Set mCol = col2
    Set col2 = Nothing

End Sub
'--------------------------------------------------------------
'  IComparer サンプル
'--------------------------------------------------------------
Sub IComparer_Sample()

    Set mCol = New Collection

    mCol.Add "1"
    mCol.Add "2"
    mCol.Add "4"
    mCol.Add "10"
    mCol.Add "6"
    mCol.Add "3"
    mCol.Add "7"
    mCol.Add "8"
    mCol.Add "5"
    mCol.Add "9"
    
    Dim v As Variant
    
    '通常のソート
    Call Sort

    For Each v In mCol
        Debug.Print v
    Next

    Debug.Print "-----------------------"
    
    'Explorerと同様のソート
    Call Sort(New ExplorerComparer)
    
    For Each v In mCol
        Debug.Print v
    Next

End Sub

結果

以下のようにソート順が変更されました。

1
10
2
3
4
5
6
7
8
9
-----------------------
1
2
3
4
5
6
7
8
9
10

最近はExploererの自然数ソートの方がしっくりくるパターンの方が多くなりましたね。

ABOUTこの記事をかいた人

はてなブックマークで驚愕の1600越えを記録した伝説が今明らかに! エクセル方眼紙 四天王の1人(ほぼ最弱)窓の杜大賞2014 大賞受賞! Excelを便利にする250以上の機能を体系化したアドインはこちらです。