Excelデータを扱う コレクションラッパークラス②

chemiphys.hateblo.jp
つづきです。

かなりの部分のコードはthomさんのこの記事を参考・・というかけっこうそのまま使わせていただいているところが多々。
thom.hateblo.jp

あと，一連の記事で学んだことも多々利用しています。
chemiphys.hateblo.jp

さて，大変な作業が始まるかと思いきや，なんか形になりそうなので，進捗状況です。

細かいところを実装する前に，まずスタート地点の確認。

標準モジュール

Sub Test()
    Dim Data As DataCollection: Set Data = New DataCollection
    
    Data.GetDataAsCollection ThisWorkbook.Worksheets(1).Range("a1"), True
    
    Data.Sort 6, False
    
    Data.Output ThisWorkbook.Worksheets(1).Range("a11"), False

End Sub

DataCollection.cls
各種メソッドやプロパティを実装するクラスになります。　※GetDataAsCollectionをFunction→Subに変更しました。

Option Explicit
Private Col As Collection
Private LabelCol As DataUnit
Private ラベル有 As Boolean
Private ParameterCount As Long

Sub GetDataAsCollection(BaseRange As Range, 先頭行ラベル As Boolean)
    Dim arr: arr = BaseRange.CurrentRegion.value
    Set Col = New Collection
    Set LabelCol = New DataUnit
    Dim i, j
    
    ParameterCount = UBound(arr, 2)
    For i = LBound(arr, 1) To UBound(arr, 1)
        With New DataUnit
            .SetParameterCount ParameterCount
            For j = 1 To ParameterCount
                .LetParameter j, arr(i, j)
            Next
            Col.Add .Self
        End With
    Next
    
    If 先頭行ラベル = True Then
        Set LabelCol = Col(1)
        Col.Remove 1
        ラベル有 = True
    End If
    
End Sub

Sub Output(BaseRange As Range, ラベル出力 As Boolean)
    Dim n As Long: n = 1
    Dim d As DataUnit
    Dim i As Long
    If ラベル出力 = True And ラベル有 = True Then
        Col.Add LabelCol, , 1
    End If
    Dim RangeArray(): ReDim RangeArray(1 To Col.Count, 1 To ParameterCount)
    
    For Each d In Col
        For i = 1 To ParameterCount
            RangeArray(n, i) = d.GetParameter(i)
        Next
        n = n + 1
    Next

    BaseRange.Resize(Col.Count, ParameterCount).value = RangeArray

End Sub

Sub Sort(Key As Long, 昇順 As Boolean)
    Dim d1 As Variant, d2 As Variant
    'バブルソート
    Dim i As Long, j As Long
    For i = 1 To Col.Count - 1
        For j = 1 To Col.Count - i
            
            d1 = CallByName(Col(j), "GetParameter", VbMethod, Key)
            d2 = CallByName(Col(j + 1), "GetParameter", VbMethod, Key)
            
            If IsGreater(昇順, d1, d2) Then CollectionSwap Col, j, j + 1
        Next j
    Next i

End Sub
Sub CollectionSwap(pCol As Collection, Index1 As Long, Index2 As Long)
    Dim Item1 As Variant, Item2 As Variant
    Set Item1 = pCol.Item(Index1)
    Set Item2 = pCol.Item(Index2)
    
    pCol.Add Item1, after:=Index2
    pCol.Remove Index2
    pCol.Add Item2, after:=Index1
    pCol.Remove Index1
End Sub

Function IsGreater(which, A, B) As Boolean
    Select Case which
        Case True: IsGreater = A > B
        Case False: IsGreater = A < B
    End Select
End Function

DataUnit.cls
データの構造体を規定しているクラスです。最低限の部分しかありませんが，汎用を考えているのでたぶんあまり変わっていかない。

Option Explicit
Private Parameter()

Property Get Self() As Object
    Set Self = Me
End Property

Sub SetParameterCount(パラメーター数 As Long)
    ReDim Parameter(1 To パラメーター数)
End Sub

Sub LetParameter(paramNo, value)
    Parameter(paramNo) = value
End Sub

Function GetParameter(paramNo) As Variant
    GetParameter = Parameter(paramNo)
End Function

試した結果はこんな感じ。

標準モジュールでは
Dim Data As DataCollection: Set Data = New DataCollection
宣言して
Data.GetDataAsCollection (ThisWorkbook.Worksheets(1).Cells(1, 1))
データを取得します。Cells(1,1)つまりA1からCurrentRegionで取得できるデータをコレクション化して保持します。
Data.Sort 6, False
１キーのバブルソートを実装しましたので，列６，降順でソートさせてみた
Data.Output ThisWorkbook.Worksheets(1).Range("a11")
結果をa11起点で出力します。

まだまだ，未実装のものもたくさんありますし，数値データはローカルウィンドウで確認したらDoubleになっていました。
小数もあるから　まずLongはだめやんと，そこは納得し，Doubleのままでいいやとそこは仕様を改善する。

勢い的にはできそうな勢いを感じますし，標準モジュール上もすっきりなのでご機嫌です。

仕様にはありませんでしたが，CurrentRegionから取得するとき，一行目がラベルかどうかってのを引数で指定できるようにしないといけないな。
そして，ラベルも保持しておいて，出力時出す出さないを選択できるようにしたい。
一部無意図にFunctionとしていたところがあったので修正。その時にラベルの有無を実装しました。

今日外出する時間帯があるのでどこまで進めるかはわかりませんが，なんとなくいいスタートです。