[[20141127142657]]　『Dictinaryを使って集計したい』（mao1212）　ページの最後に飛ぶ

『Dictinaryを使って集計したい』（mao1212）

初めて質問します。過去ログを調べて色々やってみましたが、うまく結果がでません。
教えて下さい。
AccessからExcelのSheet(da-ta)へデータをエクスポートしてExcelで請求書を作ろうとしています。Sheet(da-ta)をSheet(抽出）で顧客を抽出していますが元データが
　　I　　　J K　　　　L　　　M
商品名　　現場ID 現場名　数量　単価
2ｔｺﾝﾃﾅ　　1　　　　ああ　　1　　　200
2ｔｺﾝﾃﾅ　　1　　　　ああ　　2　　　200
2ｔｺﾝﾃﾅ　　2　　　　いい　　1　　　200
1ｔｺﾝﾃﾅ　　1　　　　いい　　5　　　100
2ｔｺﾝﾃﾅ　　1　　　　ああ　　1　　　200
2ｔｺﾝﾃﾅ　　1　　　　うう　　1　　　200
1ｔｺﾝﾃﾅ　　1　　　　ああ　　1　　　300
3ｔｺﾝﾃﾅ　　2　　　　ああ　　2　　　300

をグループ集計して同じSheetの

  　Q　　　R      S　　　　T　　 　U
商品名　　現場ID  現場名　 数量　単価
1ｔｺﾝﾃﾅ　　1　　　　ああ　　1　　　100
2ｔｺﾝﾃﾅ　　 　　　　　　  　3    　200
3ｔｺﾝﾃﾅ　　    　　　　 　　2　　　300
3ｔｺﾝﾃﾅ　  2　    　　　　　2　　　200
1ｔｺﾝﾃﾅ　　1　　　　いい　　5　　　100
2ｔｺﾝﾃﾅ　　2　　　　　　　　1　　　200
2ｔｺﾝﾃﾅ　　1　　　　うう　　1　　　200
という感じで集計したくてマクロを
Sub 集計()
 Dim myDic As Object, myKey, myItem
  Dim myVal, myVal2, myVal3
  Dim i As Long
    Range("Q3", Range("S" & Rows.Count).End(xlUp)).ClearContents
    Range("Q3:T3").Value = Range("I3:L3").Value
    Set myDic = CreateObject("Scripting.Dictionary")
    ' ---元データを配列に格納
     myVal = Range("I4", Range("I" & Rows.Count).End(xlUp)).Resize(, 3).Value
    ' ---myDicへデータを格納
         For i = 1 To UBound(myVal, 1)
            myVal2 = myVal(i, 1) & "_" & myVal(i, 2)
            If Not myVal2 = "_" Then
                If Not myDic.exists(myVal2) Then
                    myDic.Add myVal2, myVal(i, 3)
                Else
                    myDic(myVal2) = myDic(myVal2) + myVal(i, 3)
                End If
            End If
        Next
    ' ---Key,Itemの書き出し
    myKey = myDic.keys
    myItem = myDic.items
        For i = 0 To UBound(myKey)
            myVal3 = Split(myKey(i), "_")
            Cells(i + 5, 17).Value = myVal3(0)
            Cells(i + 5, 18).Value = myVal3(1)
            Cells(i + 5, 19).Value = myItem(i)

        Next
    Set myDic = Nothing
    ' ---並べ替え
    Range("Q4", Range("S" & Rows.Count).End(xlUp)).Sort _
        Key1:=Range("Q4"), Order1:=xlAscending, _
        Key2:=Range("R4"), Order2:=xlAscending, _
        Header:=xlGuess
End Sub
といろいろ調べながら記述しましたが、keyとItemの増やし方が分からず
数量が合計されません。
どうかお力を貸してください。宜しくお願いします。

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

済みませんピボットテーブル案載せましたけど、一旦削除します。
（ウッシ） 2014/11/27(木) 16:33

こんにちは

文面と表例から判断すると

Sub 集計()

    Dim myDic  As Object, myKey, myItem
    Dim myDic1 As Object, myKey1, myItem1
    Dim myVal, myVal2, myVal3
    Dim i As Long

    Range("Q3", Range("U" & Rows.Count).End(xlUp)).ClearContents
    Range("Q3:U3").Value = Range("I3:M3").Value
    Set myDic = CreateObject("Scripting.Dictionary")
    Set myDic1 = CreateObject("Scripting.Dictionary")
    ' ---元データを配列に格納
    myVal = Range("I4", Range("I" & Rows.Count).End(xlUp)).Resize(, 5).Value
    ' ---myDicへデータを格納
    For i = 1 To UBound(myVal, 1)
        myVal2 = myVal(i, 3) & "_" & myVal(i, 2) & "_" & myVal(i, 1)
        If Not myVal2 = "_" Then
            If Not myDic.exists(myVal2) Then
                myDic.Add myVal2, myVal(i, 4)
            Else
                myDic(myVal2) = myDic(myVal2) + myVal(i, 4)
            End If
            If Not myDic1.exists(myVal2) Then
                myDic1.Add myVal2, myVal(i, 5)
            Else
                myDic1(myVal2) = myVal(i, 5)
            End If
        End If
    Next
    ' ---Key,Itemの書き出し
    myKey = myDic.keys
    myItem = myDic.items
    myItem1 = myDic1.items
    For i = 0 To UBound(myKey)
        myVal3 = Split(myKey(i), "_")
        Cells(i + 5, 17).Value = myVal3(2)
        Cells(i + 5, 18).Value = myVal3(1)
        Cells(i + 5, 19).Value = myVal3(0)
        Cells(i + 5, 20).Value = myItem(i)
        Cells(i + 5, 21).Value = myItem1(i)
    Next
    Set myDic = Nothing
    Set myDic1 = Nothing
    ' ---並べ替え
    Range("Q4", Range("U" & Rows.Count).End(xlUp)).Sort _
        Key1:=Range("S4"), Order1:=xlAscending, _
        Key2:=Range("R4"), Order2:=xlAscending, _
        Key3:=Range("Q4"), Order2:=xlAscending, _
        Header:=xlGuess
End Sub

こんな感じでは？

（ウッシ） 2014/11/27(木) 17:01

 こういうこと？

 Sub test()
    Dim a, i As Long, ii As Long, txt As String, w, e, dic As Object
    a = Range("i3", Range("i" & Rows.Count).End(xlUp)).Resize(, 5).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(a, 1)
        If Not dic.exists(a(i, 3)) Then
            Set dic.Item(a(i, 3)) = _
            CreateObject("Scripting.dictionary")
        End If
            txt = Join(Array(a(i, 1), a(i, 2)), Chr(2))
        If Not dic(a(i, 3)).exists(txt) Then
            ReDim w(1 To UBound(a, 2))
            For ii = 1 To UBound(a, 2)
                w(ii) = a(i, ii)
            Next
        Else
            w = dic(a(i, 3))(txt)
            w(4) = w(4) + a(i, 4)
        End If
        dic(a(i, 3))(txt) = w
    Next
    With [q3].Resize(, 5)
        .CurrentRegion.ClearContents
        .Value = a: ii = 2
        For Each e In dic
            With .Rows(ii).Resize(dic(e).Count)
                For i = 0 To dic(e).Count - 1
                    .Rows(i + 1).Value = dic(e).items()(i)
                Next
                .Sort key1:=.Range("b1"), order1:=1, _
                    key2:=.Range("a1"), order2:=1
            End With
            ii = ii + dic(e).Count
        Next
    End With
End Sub
（seiya） 2014/11/27(木) 19:32

ウッシさん　seiyaさん忙しい中有難うございました。
お二方のご指導で完璧に出来ました。
最高です！
自分ももっと勉強して極めたいです。
本当に有難うございました。
（noa1212） 2014/11/28(金) 13:44

コメント返信：

[ 一覧(最新更新順) ]

[[20141127142657]] 『Dictinaryを使って集計したい』（mao1212） ページの最後に飛ぶ

[[20141127142657]]　『Dictinaryを使って集計したい』（mao1212）　ページの最後に飛ぶ