[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『Dictinaryを使って集計したい』(mao1212)
初めて質問します。過去ログを調べて色々やってみましたが、うまく結果がでません。
教えて下さい。
AccessからExcelのSheet(da-ta)へデータをエクスポートしてExcelで請求書を作ろうとしています。Sheet(da-ta)をSheet(抽出)で顧客を抽出していますが元データが
I J K L M
商品名 現場ID 現場名 数量 単価
2tコンテナ 1 ああ 1 200
2tコンテナ 1 ああ 2 200
2tコンテナ 2 いい 1 200
1tコンテナ 1 いい 5 100
2tコンテナ 1 ああ 1 200
2tコンテナ 1 うう 1 200
1tコンテナ 1 ああ 1 300
3tコンテナ 2 ああ 2 300
をグループ集計して同じSheetの
Q R S T U 商品名 現場ID 現場名 数量 単価 1tコンテナ 1 ああ 1 100 2tコンテナ 3 200 3tコンテナ 2 300 3tコンテナ 2 2 200 1tコンテナ 1 いい 5 100 2tコンテナ 2 1 200 2tコンテナ 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 >
文面と表例から判断すると
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
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.