[[20171012114821]]　『複数キーのDictionary』（zunzun）　ページの最後に飛ぶ

『複数キーのDictionary』（zunzun）

こんにちは
下記に示すようにＧからＪ列にデータがあります。これを期と名称の2つの条件で集計するマクロを検討しています。

     G　　H　　I　　　J　　K　　L　　M　　N　　O
3　　期　名称　個数　金額　　　期　名称　個数　金額
4　　20　ＡＡ　　2　　1000　　　20　ＡＡ　　5　1800
5　　20　ＡＡ　　3　　 800　　  21　ＢＢ　  2　1000
6　　21　ＢＢ　　2　　1000      22　ＡＡ　　2　1000
7　　22　ＡＡ　　2　　1000

ＮＥＴを参考に、以下のコードを書き実行しましたが、Ｌ、Ｍ列でＫＥＹが重なった状態で表示されます。個数と金額は正確に表示出来ています。
　　　　　　　　　　　　　　　　L　　　M　　　　　N　　　O
　　　　　　　　　　　　　　　　期　　名称　　　個数　　金額
　　　　　　　　　　　　　　　20ＡＡ　20ＡＡ　　　5　　　1800

改善点のヒントを教えていただけないでしょうか？
Dictinaryは、初心者です。
Sub 集計2()

    Dim dco_Count   As Object
    Dim dco_Sum     As Object
    Dim wRow        As Long
    Dim wKey        As String
    Dim varKeys     As Variant
    Dim var         As Variant
    Dim i           As Long
    Worksheets(8).Select

    'エクセルの列
    Const COL_I_ITEM1 = 7
    Const COL_I_ITEM2 = 8
    Const COL_I_PRICE = 10
    Const COL_O_ITEM1 = 12
    Const COL_O_ITEM2 = 13
    Const COL_O_CNT = 14
    Const COL_O_SUM = 15

    'ディクショナリオブジェクトの生成
    Set dco_Count = CreateObject("Scripting.Dictionary")
    Set dco_Sum = CreateObject("Scripting.Dictionary")

    wRow = 4    '入力データ開始行
    Do Until Cells(wRow, COL_I_ITEM1).Value = ""
        wKey = Cells(wRow, COL_I_ITEM1).Value & vbTab & Cells(wRow, COL_I_ITEM2)
        If dco_Count.Exists(wKey) Then
            'カウントアップ
            dco_Count.Item(wKey) = CLng(dco_Count.Item(wKey)) + 1
            '金額加算
            dco_Sum.Item(wKey) = CLng(dco_Sum.Item(wKey)) + _
                                 CLng(Cells(wRow, COL_I_PRICE).Value)
        Else
            '未登録の場合は新規登録
            dco_Count.Add wKey, 1
            dco_Sum.Add wKey, Cells(wRow, COL_I_PRICE).Value
        End If

        wRow = wRow + 1
    Loop

    'キー項目の配列を取得
    varKeys = dco_Count.Keys

    wRow = 4    '出力データ開始行
    '集計項目の表示
    For Each var In varKeys
        Cells(wRow, COL_O_ITEM1).Value = var
        Cells(wRow, COL_O_ITEM2).Value = var
        Cells(wRow, COL_O_CNT).Value = dco_Count.Item(var)
        Cells(wRow, COL_O_SUM).Value = dco_Sum.Item(var)

        wRow = wRow + 1
    Next

    'ディクショナリオブジェクトの破棄
    Set dco_Count = Nothing
    Set dco_Sum = Nothing

  End Sub

＜使用 Excel：Excel2013、使用 OS：Windows10 ＞

 Dictionary の Item を配列にして出し入れすれば

 Sub test()
     Dim r As Range, ii As Long, myKey As String, dic As Object, w
     Set dic = CreateObject("Scripting.Dictionary")
     dic(0) = Application.Index(Range("g3").Resize(, 4), 1, 0)
     For Each r In Range("g4", Range("g" & Rows.Count).End(xlUp))
         myKey = r.Value & Chr(2) & r(, 2).Value
         If Not dic.exists(myKey) Then
             ReDim w(1 To 4)  '<-配列を用意する
             For ii = 1 To 4  '<-Col.GからCol.Jまでを配列に格納
                 w(ii) = r.Offset(, ii - 1).Value
             Next
             dic(myKey) = w  '<-dictionaryのItemに格納
         Else
             w = dic(myKey)  '<-配列を一旦取り出す
             w(3) = w(3) + r.Offset(, 2).Value '<- 個数列を加算
             w(4) = w(4) + r.Offset(, 3).Value '<- 金額列を加算
             dic(myKey) = w '<-配列を戻す
         End If
     Next
     Range("o3").Resize(dic.Count, 4).Value = Application.Index(dic.items, 0, 0)
 End Sub
（seiya） 2017/10/12(木) 12:32

seiyaさま
提示のコードでうまく出来ました。コードの内容を勉強してみます。ありがとうございました。
ところで、当初のコードのvarを改造して表示させることは、困難だったのでしょうか？

（zunzun） 2017/10/12(木) 13:04

 2箇所...

 1)
            'カウントアップ これは個数の加算でしょ?
            dco_Count.Item(wKey) = CLng(dco_Count.Item(wKey)) + Cells(wRow, 9).Value

 2)
            '未登録の場合は新規登録
            dco_Count.Add wKey, Cells(wRow, 9).Value

 だと思いますが？
（seiya） 2017/10/12(木) 13:26

seiyaさま

試してみましたが、期と名称が合体されたままでした。
seiyaさんのコードを勉強してみます。
ありがとうございました。
（zunzun） 2017/10/12(木) 13:44

 ああ、そこですか...

        Cells(wRow, COL_O_ITEM1).Value = var
        Cells(wRow, COL_O_ITEM2).Value = var
 を
        Cells(wRow, COL_O_ITEM1).resize(,2).Value = split(var,vbtab)
 かな？
（seiya） 2017/10/12(木) 13:49

seiyaさま
出来ました。
Dictionaryを勉強してみます。
ありがとうございました。
（zunzun） 2017/10/12(木) 13:56

コメント返信：

[ 一覧(最新更新順) ]

[[20171012114821]] 『複数キーのDictionary』（zunzun） ページの最後に飛ぶ

[[20171012114821]]　『複数キーのDictionary』（zunzun）　ページの最後に飛ぶ