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

質問

条件4項目　日付＆単位＆単価＆区分（Ａ列、Ｃ列、Ｄ列、Ｆ列）の一致するもののＢ列及びＥ列を集計して別シートに書き出したいのです。　

sheet1
Ａ　　　Ｂ　　　Ｃ　　　Ｄ　　　Ｅ　　　Ｆ
日付　 数　　 単位　 単価　 計　　 区分
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
Ａ　　　Ｂ　　　Ｃ　　　Ｄ　　　Ｅ　　　Ｆ
日付 数 単位 単価 計 区分
3/12　　3　　　　人　　10000　30000　　通常
3/12　　1　　　　時間　 2000　10000　　残業
3/14　　4　　　　時間　 2000　 8000　　残業
3/15　　4　　　　人　　10000　40000　　通常

のようにまとめたいのです。
Dictionaryを用い、Ａ列、Ｃ列、Ｄ列、Ｆ列を一旦結合しkeyとし、同じものが登録されていたら、itemとしてＢ列及びＥ列の値を加算させて、登録件数分を書き出しという流れでやりたいのですが、出来ません。
助けて下さい。お願いします。

回答No.4

end-u · ベストアンサー

/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]キーで１ステップずつ実行するのが効果的です。
その時[ローカルウィンドウ]を表示させて、変数や配列への格納のされ方も確認してくださいね。

お礼

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

補足

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

回答No.5

end-u

#4補足に対するレスを入れておきます。
（もしかしたら削除対象回答に該当するかもしれませんが、事務局のご判断におまかせします。）

お礼についてはお気持ちだけで充分です。お気になさらず。
回答側の立場で投稿してますが、私も勉強になる事が多いです。
回答者というより利用者という感覚で、Q&Aをケーススタディとして勉強させてもらってます。
それに
http://help.okwave.jp/okwave/beginner/beginner.html
『OKWaveは利用者の方々からの「質問」と「回答」を通し、世の中のあらゆる問題の解決と、人と人の相互協力のリレーション作りを目指すQ&Aサイトです。』
とあるように、『相互協力』ですから、利用者各個人の得意分野を補完し合っていけば良いのだと思います。
直接私に対してではなくとも、貴方も誰かのお役に立たれているはずです。
そういった連鎖関係の中でお互いが得していると考えておけば良いんじゃないでしょうか。
それはこれから先の事でも構わないし、このコミュニティ内に限った事でもないと思います。

他、今後気をつけたほうがいい事として１点、アドバイスです。
今一度、『■禁止事項ガイドライン』に眼を通されておかれたほうが良いでしょう。
http://help.okwave.jp/okwave/beginner/prohibition.html
会員間の直接のやり取りを促すような記述は削除・編集の対象となっています。
私もメールアドレスなどを公開するつもりはありませんし、前述したように、何か物的なものをお受けするつもりはさらさらありません。
（かといって、補足にお書きになった事で気分を害しているわけでもありません。本当に、お気持ちだけ嬉しくお受け致します^ ^）

本来は、このレスも『指摘回答』だと判断されて削除対象になるかもしれませんが、私からもお礼の気持ちが伝わればと思って書きました。
では、今後ともよろしくお願いします。お互いにこのコミュニティを通して、問題解決やスキルアップができれば良いですネ。

お礼

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

回答No.3

n-jun

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

お礼

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

回答No.2

imogasi

エクセル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行見出しは、元のシートの見出し行をコピー貼り付けする。

補足

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

回答No.1

fujillin

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

補足

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