久々のVBA　ノンプロ研中級講座の内容を活かす?

こんにちは。
派犬事務員のコロ子です。

実は去年12月にノンプロ研中級講座が終わってから、全くVBAを書いていなかった。
4月から部署を異動するので、ルーチン業務から外れ毎日雑用の日々。
最近はPython（GASにも）に気を取られてVBAはもうしばらくいいかなー、気分になっていた。

そんなダラダラした気分のところに上司から「マクロ作って」の依頼がきた。
VBAもういいや、な気分だったのに、話を聞いたらノンプロ研中級講座の内容がめちゃめちゃ使えそうだったから、少し気分が乗ってきた。

しかし、3ヶ月VBAをやってなかっただけなのに、関数の外にコード書いたり、変数を宣言するのを忘れたり、もうVBA忘れちゃったのかものひどい有り様だった。

ゆっくり良く考えてかっこいいコードが書きたかったけど、「急ぎ」だったので、とりあえず急いで作った。もっといい方法がないか今日考えたけど、時間があるからといっていいアイデア浮かぶわけでもない・・・。
でもノンプロ研中級講座の内容を盛り込めたと思う。

【内容】
下記のようなデータを番号、Lotが同じもので集計する。
データ1、データ2、データ3は各々最大値と最小値を除いて平均する。
f:id:SNegishi:20200320175627p:plain

表をテーブルにする。

表の中にカーソルを置いて「Ctrl＋T」を押すとテーブルになる！
f:id:SNegishi:20200320181016p:plain

色が付いてオシャレになっただけじゃない。
テーブルにすると表をオブジェクトとして扱えるから便利。

考え方

①表の「番号」と「Lot」を繋げた文字列をキーにする。
【例】
2行目の場合は「BBBabc」がキー

②表の1行分のデータを格納するクラスを用意する。

③表を1行づつ読み込んで、Dictionaryオブジェクトに格納する
Key：①で作成したキー
Item：②のクラスを配列にして、配列のインデックス番号

Dictionaryオブジェクトに格納する際、Keyがすでに存在していたら、そのインデックス番号のクラスのデータを集計する。

コード

クラスモジュール　RawDataクラス

Private no_ As String
Private lot_ As String
Private data1_ As Long
Private data2_ As Long
Private data3_ As Long
Private max1_ As Long
Private min1_ As Long
Private max2_ As Long
Private min2_ As Long
Private max3_ As Long
Private min3_ As Long
Private cnt_ As Long

'*初回の値をセット
Public Sub Init(ByVal list As ListRow)

    no_ = list.Range(cnNo)
    lot_ = list.Range(cnLot)
    
    data1_ = list.Range(cnData1)
    max1_ = data1_
    min1_ = data1_
    
    data2_ = list.Range(cnData2)
    max2_ = data2_
    min2_ = data2_
    
    data3_ = list.Range(cnData3)
    max3_ = data3_
    min3_ = data3_
    
    cnt_ = 1

End Sub


'*加算
Public Sub Add(ByVal list As ListRow)

    data1_ = data1_ + list.Range(cnData1)
    Call MaxMin(max1_, min1_, list.Range(cnData1))
    
    data2_ = data2_ + list.Range(cnData2)
    Call MaxMin(max2_, min2_, list.Range(cnData2))
    
    data3_ = data3_ + list.Range(cnData3)
    Call MaxMin(max3_, min3_, list.Range(cnData3))
    
    cnt_ = cnt_ + 1

End Sub

'最大値と最小値を探す
'(max, minはByRefにして変数の中身を置き換える）
Public Sub MaxMin(ByRef max As Long, ByRef min As Long, ByVal Data As Long)

    If Data > max Then
        max = Data
    ElseIf Data < min Then
        min = Data
    End If

End Sub


'番号
Public Property Get No() As String

    No = no_

End Property

'ロット
Public Property Get Lot() As String

    Lot = lot_

End Property

'データ1
Public Property Get Data1() As Long

    Data1 = WorksheetFunction.Round((data1_ - max1_ - min1_) / (cnt_ - 2), 0)

End Property

'データ2
Public Property Get Data2() As Long

    Data2 = WorksheetFunction.Round((data2_ - max2_ - min2_) / (cnt_ - 2), 0)

End Property

'データ3
Public Property Get Data3() As Long

    Data3 = WorksheetFunction.Round((data3_ - max3_ - min3_) / (cnt_ - 2), 0)

End Property

Sheet1モジュール

Public Property Get Key(list As ListRow) As String
    
    Key = list.Range(cnNo) & list.Range(cnLot)

End Property

Sheet2モジュール

Public Sub Del()

    Me.UsedRange.Offset(1, 0).Delete

End Sub

Public Sub MakeStyle()

'罫線
Me.Range("A2").CurrentRegion.Borders.LineStyle = xlContinuous
'ソート
Me.Range("A2").CurrentRegion.Sort Key1:=Range("A1"), _
                                  Order1:=xlAscending, _
                                  Key2:=Range("B1"), _
                                  Order2:=xlAscending, _
                                  Header:=xlYes


End Sub

標準モジュール

参照設定：Microsoft Scripting Runtimeを忘れずに。

Public Enum ColumnName

    cnNo = 1
    cnLot
    cnData1
    cnData2
    cnData3

End Enum

Public Sub Aggregate()

Dim list As ListObject
Set list = Sheet1.ListObjects(1)

Dim ran As ListRow

Dim Dic As Dictionary
Set Dic = New Dictionary

'RawDataクラスは動的配列にする
Dim Data() As RawData
Dim i As Long

'データ読み込み
For Each ran In list.ListRows

        Dim kye As String
        kye = Sheet1.Key(ran)
        
        If Dic.Exists(kye) Then
            'すでにkeyが存在している時は、配列のインデックス番号のデータを加算
            Call Data(Dic.Item(kye)).Add(ran)
            
        Else
        
            'keyが存在しない（初めて）時は、Dicにデータを格納
            ReDim Preserve Data(i)
            Set Data(i) = New RawData
            
            Dic.Add kye, i
            Call Data(i).Init(ran)
            i = i + 1
        End If

Next ran

Call Sheet2.Del

'データ書き出し
For i = 2 To UBound(Data) + 2

    Sheet2.Cells(i, cnNo).Value = Data(i - 2).No
    Sheet2.Cells(i, cnLot).Value = Data(i - 2).Lot
    Sheet2.Cells(i, cnData1).Value = Data(i - 2).Data1
    Sheet2.Cells(i, cnData2).Value = Data(i - 2).Data2
    Sheet2.Cells(i, cnData3).Value = Data(i - 2).Data3

Next i

Call Sheet2.MakeStyle
Sheet2.Activate

End Sub