インストールレスプログラミング( ´ー`)

VBA , JavaScript , HTAなど 365アプリはインストール必要ですが、仕事に無いケースはほぼないから(・_・;)

フィールド数が多いデータに取り組む ③

基本シリーズを終えたので,比較的急いでいる フィールド数が多いデータへの取り組みを再開。thomさんのコードをガン見しながら少しずつ進める。
chemiphys.hateblo.jp

列数20,ID~ソートキー5 をとりあえずフィールドに置いてみました。
f:id:chemiphys:20170109235627p:plain

最終的にはいくつかのフィールドを混合したクラスのプロパティを作ったりしているので,プロパティで並べ替えたいというのが正直なところ。

でも,プロパティをコレクションの引数に入れてソートを作るというのが今のところできていません。

苦肉の策として,getProperty,LetPropertyのまねをして,

Sub LetProp(propno, value)
    prop(propno) = value
End Sub

Function GetProp(propno)
    GetProp = prop(propno)
End Function

とプロパティをIDで指定できるようにして,

        With New person
            For j = 1 To 列数
                .LetParameter j, arr(i, j)
            Next
                .LetProp 1, .ID
                .LetProp 2, .ソートキー1
                .LetProp 3, .ソートキー2
                .LetProp 4, .ソートキー3
                .LetProp 5, .ソートキー4
                .LetProp 6, .ソートキー5
            Col.Add .Self
        End With

コードが長くなりますが,プロパティをperson classに入れました。
f:id:chemiphys:20170110000634p:plain

ソートは次のような感じ。キーをIDで与える。

Sub CSort(Col As Collection, Key1 As Long, Optional Key2 As Long )
    Dim p1 As person, p2 As person
    'バブルソート
    Dim i As Long, j As Long
    For i = 1 To Col.Count
        For j = Col.Count To i Step -1
            Set p1 = Col(i)
            Set p2 = Col(j)
            If p1.GetProp(Key1) > p2.GetProp(Key1) Then
                CollectionSwap Col, i, j
            ElseIf IsMissing(Key2) = False And p1.GetProp(Key1) = p2.GetProp(Key1) Then  'キー2の評価
                On Error Resume Next
                    If p1.GetProp(Key2) < p2.GetProp(Key2) Then
                        CollectionSwap Col, i, j
                    End If
                On Error GoTo 0
            End If
        Next j
    Next i

End Sub

プロパティもEnumで宣言し,可読性は少し上げておいて

Public Enum pp
    ID = 1
    ソートキー1
    ソートキー2
    ソートキー3
    ソートキー4
    ソートキー5
End Enum

メインの処理はこんな感じ。

Sub メイン処理()
    Dim Col As Collection: Set Col = GetDataAsCollection
    Dim p As person, k As Long
    Dim a As Variant
    
    a = Report(Col)

    'ソート前出力
    ThisWorkbook.Worksheets("出力").Range("a1").Resize(Col.Count, 列数) = a

    
    CSort Col, pp.ソートキー2, pp.ソートキー3
    
    'ソート結果出力
    
    a = Report(Col)
    
    ThisWorkbook.Worksheets("出力").Range("a25").Resize(Col.Count, 列数) = a

End Sub
Function Report(Col As Collection) As Variant

Dim p As person, Rangearray()
Dim i As Long, n As Long: n = 1
ReDim Rangearray(1 To Col.Count, 1 To 列数)

For Each p In Col
    For i = 1 To 列数
        Rangearray(n, i) = p.GetParameter(i)
    Next
    n = n + 1
Next
Report = Rangearray
End Function

Function SortKey(V As Variant)
    SortKey = V.Top
End Function

Sortkeyはまだ活かせていません。

これでなんとかできるようになりましたが,やはりプロパティを利用してソートしたいなぁというところ。

とりあえず最低限動くというところはいけたので,少しずついいものにしていこう。

時間がなかったのでこのエントリだけでは見てもさっぱりなものになりました(;´▽`A`` ネマス