コレクション内のオブジェクトのプロパティを利用したソート1

あけましておめでとうございます。
本年もマイペースでやっていきます。

年明け早々、あの様な震災があったり、それに伴った人災(航空機の接触)と
心痛む出来事の連続で唖然としつつ、普通に正月を迎えられることが
非常に幸せな事なのだと感じております・・・。
(ご冥福をお祈りいたします)

あぁ今年は目標を立てない事にします。昨年一つも達成しなかったので。

昨年の11月に、こちらをチラッと書きました。
ボディの体積をダンプする5 - C#ATIA
ここではCATIAのオブジェクトを利用したソートになっていますが、
興味があるのはそういう事ではなく、
"コレクション内のオブジェクトのプロパティを利用したソート"
についてがテーマでした。
これは僕にとってVBAの大きな疑問です。

昨年末頃にこちらを試しました。
Bingチャットでコードレビュー - C#ATIA
その際、気づかなかったのですが、後で"AIはどんな処理を書くの？"と
言う疑問が湧き、試した所これが中々面白かったです。

実は年末にBingチャットで試した際、最初はJavaのコードを答えられ、
"VBAで教えて下さい”と追加質問したところ、
"他の言語は学習していますがVBAは学習していない為、答えられません"
のような回答となりました。
(思わず、BingはVBAを答えないとダメだろ　と突っ込みました)

今日、（恐らく質問文が異なっていると思います）再度質問したところ
答えてくれました。
念の為、こちらの文章で質問してみました。

VBAで次のPoint2Dクラスモジュールがあります。
'vba Point2D.cls

Option Explicit

public x As Double
public y As Double

このPoint2Dクラスのインスタンスを複数保持しているPointsコレクションがあります。

このコレクションを原点から近い順にソートされたコレクションが得られるVBAの関数を教えて下さい。

Bingチェットが答えてくれたコードのみです。

'Point2Dクラスのインスタンスの距離を計算する関数
Function Distance(p As Point2D) As Double
    Distance = Sqr(p.x ^ 2 + p.y ^ 2)
End Function


'Pointsコレクションを原点から近い順にソートする関数
Function SortByDistance(points As Collection) As Collection
    Dim i As Long, j As Long
    Dim n As Long
    Dim temp As Point2D
    n = points.Count 'コレクションの要素数
    'バブルソートのアルゴリズム
    For i = 1 To n - 1
        For j = i + 1 To n
            '距離が小さいものを前に移動する
            If Distance(points(j)) < Distance(points(i)) Then
                Set temp = points(i)
                Set points(i) = points(j)
                Set points(j) = temp
            End If
        Next j
    Next i
    'ソートされたコレクションを返す
    Set SortByDistance = points
End Function

これだけでは試す事が出来ない為、幾つかの関数を用意しました。
（これをBingチャットに書かせる自信が無いので・・・）

'エントリーポイント
Sub main()
    Dim coordinates As Variant
    coordinates = Array( _
        Array(0, 1), _
        Array(2, 12), _
        Array(5, 5), _
        Array(20, 3), _
        Array(8, 2), _
        Array(10, 5), _
        Array(0, 2) _
    )
    
    Dim points As Collection
    Set points = New Collection
    
    Dim pnt As Point2D
    Dim i As Long
    For i = 0 To UBound(coordinates)
        Set pnt = New Point2D
        pnt.x = coordinates(i)(0)
        pnt.y = coordinates(i)(1)
        points.Add pnt
    Next
    
    dump_points points, "** before **"

    Dim sortedPoints As Collection
    Set sortedPoints = SortByDistance(points)

    dump_points sortedPoints, "** after **"
End Sub


Private Sub dump_points( _
    ByVal points As Collection, _
    Optional ByVal msg As String = "")
    
    If Len(msg) > 0 Then
        Debug.Print msg
    End If
    
    Dim pnt As Point2D
    For Each pnt In points
        dump_point pnt
    Next
End Sub


Private Sub dump_point( _
    ByVal point As Point2D)
    
    Debug.Print "X:" & point.x & " Y:" & point.y
End Sub

又、質問時に定義している"Point2D.cls"クラスモジュールも念の為
記載しておきます。

'vba Point2D.cls

Option Explicit

Public x As Double
Public y As Double

用意が整ったので、実行したところエラーとなりました。
この部分でのエラーです。

                Set points(i) = points(j)

・・・実行する前から気が付いていましたが、念の為実行してみました。

これはコレクション内の要素を書き換えようとした際の部分ですが、
そこでエラーとなります。

そうなんです、VBAのコレクションは内部の要素の上書きが出来ないんです。
ソート処理には幾つかアルゴリズムがありますが（僕はあまり詳しくないです）
何れもスワップ処理が必要となりますが、VBAのコレクションは要素の
上書きが出来ない為、この部分が非常にネックとなるはずです。
（コレクションのRemoveメソッドと挿入位置指定のAddメソッドで
出来ない事は無いはずですが、面倒です）

続いてBingチャットにこちらを質問しました。

VBAのコレクションは要素の再代入が出来ない為エラーになります。

得られた回答のコード部分です。

'Point2Dクラスのインスタンスの距離を計算する関数
Function Distance(p As Point2D) As Double
    Distance = Sqr(p.x ^ 2 + p.y ^ 2)
End Function


'Pointsコレクションを原点から近い順にソートする関数
Function SortByDistance(points As Collection) As Collection
    Dim i As Long, j As Long
    Dim n As Long
    Dim temp As Point2D
    Dim arr() As Point2D '配列を宣言
    n = points.Count 'コレクションの要素数
    ReDim arr(1 To n) As Point2D '配列のサイズを指定
    'コレクションの要素を配列にコピー
    For i = 1 To n
        Set arr(i) = points(i)
    Next i
    'バブルソートのアルゴリズム
    For i = 1 To n - 1
        For j = i + 1 To n
            '距離が小さいものを前に移動する
            If Distance(arr(j)) < Distance(arr(i)) Then
                Set temp = arr(i)
                Set arr(i) = arr(j)
                Set arr(j) = temp
            End If
        Next j
    Next i
    'コレクションを空にする
    For i = n To 1 Step -1
        points.Remove i
    Next i
    '配列の要素をコレクションに追加
    For i = 1 To n
        points.Add arr(i)
    Next i
    'ソートされたコレクションを返す
    Set SortByDistance = points
End Function

結論からすると正しく処理出来るものになっていました。

結局、

コレクション→配列→ソート→コレクション

の処理を行っています。正直な所、予想通りです。

VBAの悩ましい部分がここなんです。
・コレクション：代入する際の要素数は自動拡張するが、再代入が出来ない。
・配列：再代入可能だが、要素数は自動拡張しない。
細かな事を言えば、メモリの確保の仕方の違いなどもあるとは思いますが、
何時も"どっち使う？"になってしまいます。（個人的には配列）

もうちょっと試しているのですが、長くなったので次回に。