• ベストアンサー

Dictionaryを使い4つの条件の一致で2つの集計列を集計したいのです

条件4項目 日付&単位&単価&区分(A列、C列、D列、F列)の一致するもののB列及びE列を集計して別シートに書き出したいのです。  sheet1 A   B   C   D   E   F 日付  数   単位  単価  計   区分 3/12  2    人  10000 20000  通常 3/12  1    人  10000 10000  通常 3/12  1    時間  2000 10000  残業 3/14  4    時間  2000  8000  残業 3/15  4    人  10000 40000  通常 このような表を sheet2 A   B   C   D   E   F 日付 数 単位 単価 計 区分 3/12  3    人  10000 30000  通常 3/12  1    時間  2000 10000  残業 3/14  4    時間  2000  8000  残業 3/15  4    人  10000 40000  通常 のようにまとめたいのです。 Dictionaryを用い、A列、C列、D列、F列を一旦結合しkeyとし、同じものが登録されていたら、itemとしてB列及びE列の値を加算させて、登録件数分を書き出しという流れでやりたいのですが、出来ません。 助けて下さい。お願いします。

質問者が選んだベストアンサー

  • ベストアンサー
  • end-u
  • ベストアンサー率79% (496/625)
回答No.4

/qa4512348.html の続きですか? その情報をリンク貼っておけば回答側の参考にもなったと思いますよ。 >DictionaryのItemには追加時に連番をふりながら(その連番を)Indexとしてセットし、 >『集計&転記用の配列を別に用意』し、 >Indexでその配列への加算位置を指定してあげるほうが簡単かもしれません。 と書いてたでしょう。 Sub try_3()   Dim dic As Object 'Dictionary用   Dim s  As String 'キー文字列結合用   Dim key As Variant 'key列用   Dim ary As Variant '集計列用   Dim c  As Variant '配列Loop用   Dim v  As Variant '元データ格納用配列   Dim w  As Variant 'データ集計・書き出し用配列   Dim n  As Long  '配列の要素index用   Dim i  As Long   Dim j  As Long   key = Array(1, 3, 4, 6) 'key列   ary = Array(2, 5)    '集計列   With ThisWorkbook     v = .Sheets("sheet1").Range("A1").CurrentRegion '.Resize(, 6)     ReDim w(1 To UBound(v, 1), 1 To UBound(v, 2))     Set dic = CreateObject("Scripting.Dictionary")     n = 0     For i = 1 To UBound(v)       'キー文字列 s として結合       s = ""       For Each c In key         s = s & v(i, c) & vbTab       Next       If dic.Exists(s) Then         '既登録ならindexを取得         j = dic(s)       Else         '未登録ならindexを追加         n = n + 1         dic(s) = n         j = n         '未登録なら書き出し用配列 w にkey列をセット         For Each c In key           w(j, c) = v(i, c)         Next       End If       '書き出し用配列 w に集計列を加算       For Each c In ary         w(j, c) = w(j, c) + v(i, c)       Next     Next     With .Sheets("sheet2")       .UsedRange.ClearContents       .Range("A1").Resize(n, UBound(w, 2)).Value = w     End With   End With   Set dic = Nothing End Sub 前回のコードでも、keyを増やして key1 key2 key3 key4 集計1 集計2 日付 単位 単価 区分 数   計 の順で書き出した後に、列を入れ替えればよかったんじゃないですか? #以下、既に実施済みでしたら読み飛ばしてください。 コードを理解するには、ただ眺めるだけじゃなく、VBE[F8]キーで1ステップずつ実行するのが効果的です。 その時[ローカルウィンドウ]を表示させて、変数や配列への格納のされ方も確認してくださいね。

yokokama46
質問者

お礼

end-uさん。今戻りました。バッチリです。 しかしまだまだ ReDim w(1 To UBound(v, 1), 1 To UBound(v, 2))の部分が私にとって鬼門です。配列の要素数の再定義 この部分をしっかり理解しないと、一気に出来ず、Dictionaryを2回使ったりしなければならなくなりそうです。この部分を勉強させてもらいます。

yokokama46
質問者

補足

 end-uさん最近はお世話になりっぱなしです。 全てend-uさんのおっしゃる通りです。じつは前回のコードで、keyを増やして key1 key2 key3 key4 集計1 集計2 日付 単位 単価 区分 数   計 の順で書き出した後に、列を入れ替えて書き出して動かしてました。(下記のコードで入れ替え。)  vntData_2 = Columns("B").Value vntData_3 = Columns("C").Value vntData_4 = Columns("D").Value vntData_5 = Columns("E").Value vntData_6 = Columns("F").Value Columns("B").Value = vntData_5 Columns("C").Value = vntData_2 Columns("D").Value = vntData_3 Columns("E").Value = vntData_6 Columns("F").Value = vntData_4 しかし、少し時間(列入れ替え時)かかるのと、今回は入れ替えの無いパターンなので、前は作れたのに、時間が経って忘れてしまったのか、今回は単純なパターンなのにつまづいてしまったのは、基礎が、身に付いてなかったせいと思い、そこでまた皆様のお力をお借りしたのでした。本当に忘れないようにします。私は、出張が多いので、本当にお世話になりまくりのend-uさんには、何かお土産でも渡したいと思ってます(心から)なにかよい方法(メールアドレス等)でも教えてもらえれば幸いです。今また出かけなければならないので、ここのお礼は、後ほど必ずいたします。YOKOKAMA46

すると、全ての回答が全文表示されます。

その他の回答 (4)

  • end-u
  • ベストアンサー率79% (496/625)
回答No.5

#4補足に対するレスを入れておきます。 (もしかしたら削除対象回答に該当するかもしれませんが、事務局のご判断におまかせします。) お礼についてはお気持ちだけで充分です。お気になさらず。 回答側の立場で投稿してますが、私も勉強になる事が多いです。 回答者というより利用者という感覚で、Q&Aをケーススタディとして勉強させてもらってます。 それに http://help.okwave.jp/okwave/beginner/beginner.html 『OKWaveは利用者の方々からの「質問」と「回答」を通し、世の中のあらゆる問題の解決と、人と人の相互協力のリレーション作りを目指すQ&Aサイトです。』 とあるように、『相互協力』ですから、利用者各個人の得意分野を補完し合っていけば良いのだと思います。 直接私に対してではなくとも、貴方も誰かのお役に立たれているはずです。 そういった連鎖関係の中でお互いが得していると考えておけば良いんじゃないでしょうか。 それはこれから先の事でも構わないし、このコミュニティ内に限った事でもないと思います。 他、今後気をつけたほうがいい事として1点、アドバイスです。 今一度、『■禁止事項ガイドライン』に眼を通されておかれたほうが良いでしょう。 http://help.okwave.jp/okwave/beginner/prohibition.html 会員間の直接のやり取りを促すような記述は削除・編集の対象となっています。 私もメールアドレスなどを公開するつもりはありませんし、前述したように、何か物的なものをお受けするつもりはさらさらありません。 (かといって、補足にお書きになった事で気分を害しているわけでもありません。本当に、お気持ちだけ嬉しくお受け致します^ ^) 本来は、このレスも『指摘回答』だと判断されて削除対象になるかもしれませんが、私からもお礼の気持ちが伝わればと思って書きました。 では、今後ともよろしくお願いします。お互いにこのコミュニティを通して、問題解決やスキルアップができれば良いですネ。

yokokama46
質問者

お礼

end-uさん。有難うございます。 おっしゃるとおり今まで KenKen-SPさん、n-junさん、onlyromさん、redfox63さん,そしてend-uさん、そのほかの方々 色々な方にお世話になっております。OKWAVEには感謝しております。 end-uさんには特にお世話になっている回数が多いのと私のプロフィールに書いてある通り、以前の私の質問に(締切済み)追加でメール頂いた件は、内容もその後の私の悩みにドンピシャだったので非常に助かった思いがありました。そこで今回のような発言だったのですが、禁止事項ガイドラインにふれるのですね。無念です。それではせめて、end-uさんのご多幸を祈らせて頂くことにとどめます。 またお手数かけることも多いとは思いますが今後もよろしくお願いいたします。yokokama46

すると、全ての回答が全文表示されます。
  • n-jun
  • ベストアンサー率33% (959/2873)
回答No.3

Excel(エクセル) VBA入門:Dictionaryオブジェクトを利用する http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_dictionary.html 【Dictionaryオブジェクトを作成する】 ”・ところが、A列の品名が重複していると、~” と言う所が参考になるのでは?

yokokama46
質問者

お礼

n-junさん返事遅れてすみません。以前n-junさんから頂いたコードのシンプル版なので、end-uさんへの補足に述べさせて頂いたとおり、n-junさんから頂いたコードを最後に列の入れ替えをして、対応は出来たのですが、入れ替え無いパターンは(ただし集計列1列)自分でも出来ていたので、集計列2列にも挑戦したのですが、撃沈でした。そこでn-junさんから頂いたコードを最後に列の入れ替えをする対応で済ます予定でしたが、せっかくだから基本を覚えようと思ったしだいです。n-junさんは色々なかたに幅広く答えていらっしゃいますし私も何度かお世話になっております。重ねてお礼申し上げます。 またよろしくお願いします。yokokama46

yokokama46
質問者

補足

n-junさん 以前も助けて頂きました。今回もまたお手数かけます。 以前もDictionaryを用い似たような集計(条件列と集計列が書き出し時に一部入れ替えがあるので、集計列をaryで示すという方法でした) 今回は書き出し時にレイアウト変更がないのですが、基本を押さえてなかったようで、自分でうまくいきません。 ご提示のページも参考にさせていただきましたが、4条件を結合は下記でよいと思いますが、その先の2つのアイテム追加のしかたと、出来たとしても書き出し時がいまいち解りません。これを機に今一度Dictionaryの勉強をしますので、なにとぞご教示のほどよろしくお願いします。 myVal = sh1.Range("F1", sh1.Range("A" & sh1.Rows.Count).End(xlUp)).Value Set myDic = CreateObject("Scripting.Dictionary") For i = 2 To UBound(myVal, 1) End If myVal2 = myVal(i, 1) & "_" & myVal(i, 3) & "_" & myVal(i, 4) & "_" & myVal(i, 6) If Not myVal2 = "_" & "_" & "_" Then If myDic.exists(myVal2) Then

すると、全ての回答が全文表示されます。
  • imogasi
  • ベストアンサー率27% (4737/17069)
回答No.2

エクセルVBAを、どれほどこなせるレベルか知ら無いが、Dictionaryなどの凝った仕組みを使わずとも、普通のVBA(ソート法などで)簡単に出来るよ。Dictionaryの練習問題ならいざ知らず、ベテランはなるべく単純な使い慣れた仕組みを使うと思う。 Dictionaryを使いこなせるレベルなら、デバッグなど自力で出来る力が有るはずだ。 Googleででも「VBScript dictionary」で照会でもして、たくさん出る記事の適当なものを読みましたか。 ーーー 文字列を結合したKeyを作るとき、定桁結合式にしないと、おかしくなることが有ることを注意してますか。 ーーー 私の言うやり方でやってみる。 IFと代入しか使ってない。質問者は、他シート参照がなれているかな。 ただしロジックは易しいと思うが、先人のロジックで、長く使い続けて慣れた面はある。 例データ ソート後 日付 数 単位 単価 計 区分 3月12日 1 時間 2000 10000 残業 3月12日 2 人 10000 20000 通常 3月12日 1 人 10000 10000 通常 3月12日 4 人 10000 10000 通常 3月12日 2 人 10000 20000 通常 3月14日 4 時間 2000 8000 残業 3月14日 2 人 10000 20000 通常 3月15日 4 人 10000 40000 通常 3月15日 1 人 20000 20000 通常 3月15日 2 人 20000 20000 通常 ーー コード Sub test01() Dim sh1, sh2 As Worksheet Set sh1 = Worksheets("Sheet2") Set sh2 = Worksheets("Sheet3") d = sh1.Range("A65536").End(xlUp).Row MsgBox d k = 2: t1 = 0: t2 = 0 m1 = sh1.Cells(2, "A"): m2 = sh1.Cells(2, "C"): m3 = sh1.Cells(2, "D"): m4 = sh1.Cells(2, "F") '--- For i = 2 To d If sh1.Cells(i, "A") = m1 And sh1.Cells(i, "C") = m2 And sh1.Cells(i, "D") = m3 And sh1.Cells(i, "F") = m4 Then t1 = t1 + sh1.Cells(i, "B") t2 = t2 + sh1.Cells(i, "E") Else sh2.Cells(k, "A") = m1 sh2.Cells(k, "B") = t1 sh2.Cells(k, "C") = m2 sh2.Cells(k, "D") = m3 sh2.Cells(k, "E") = t2 sh2.Cells(k, "F") = m4 k = k + 1 m1 = sh1.Cells(i, "A"): m2 = sh1.Cells(i, "C"): m3 = sh1.Cells(i, "D"): m4 = sh1.Cells(i, "F") t1 = sh1.Cells(i, "B") t2 = sh1.Cells(i, "E") End If Next i sh2.Cells(k, "A") = m1 sh2.Cells(k, "B") = t1 sh2.Cells(k, "C") = m2 sh2.Cells(k, "D") = m3 sh2.Cells(k, "E") = t2 sh2.Cells(k, "F") = m4 End Sub ーーー 結果 日付 数 単位 単価 計 区分 2009/3/12 1 時間 2000 10000 残業 2009/3/12 9 人 10000 60000 通常 2009/3/14 4 時間 2000 8000 残業 2009/3/14 2 人 10000 20000 通常 2009/3/15 4 人 10000 40000 通常 2009/3/15 3 人 20000 40000 通常 第1行見出しは、元のシートの見出し行をコピー貼り付けする。

yokokama46
質問者

補足

imogasiさん。急用で出かけてまして今戻りました。返事遅れてすいません。出かける直前に、最後のend-uさんのコードを試させて頂き動きました。imogasiさんのは今試させていただいたのですが、imogasiさんの例示とその結果のようになればよいのですが、なぜか、同項目同士の累計がなされませんでした。(累計なくまったく同じものが転記される)。もしかしたら私のミスかもしれませんのでお気を悪くせずに今後もよろしくお願いします。

すると、全ての回答が全文表示されます。
  • fujillin
  • ベストアンサー率61% (1594/2576)
回答No.1

まずはできているものを提示なさっては? また、どのようにうまくいかないのでしょうか?

yokokama46
質問者

補足

fujillinさん初めまして。最初に返事頂いたのに諸事情により、返事遅れてすみませんでした。やりたかったことと途中までのコードは、n-junさんへの解答のとうりでした。色んな方のお力をお借りしてばかりの私なので今後ともよろしくお願いします。

すると、全ての回答が全文表示されます。

関連するQ&A

専門家に質問してみよう