プロが教えるわが家の防犯対策術!

条件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列の値を加算させて、登録件数分を書き出しという流れでやりたいのですが、出来ません。
助けて下さい。お願いします。

教えて!goo グレード

A 回答 (5件)

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

この回答への補足

 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

補足日時:2009/05/13 16:36
    • good
    • 0
この回答へのお礼

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

お礼日時:2009/05/13 22:08

#4補足に対するレスを入れておきます。


(もしかしたら削除対象回答に該当するかもしれませんが、事務局のご判断におまかせします。)

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


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



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

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

お礼日時:2009/05/13 22:29

Excel(エクセル) VBA入門:Dictionaryオブジェクトを利用する


http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/v …
【Dictionaryオブジェクトを作成する】
”・ところが、A列の品名が重複していると、~”
と言う所が参考になるのでは?

この回答への補足

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

補足日時:2009/05/13 15:31
    • good
    • 0
この回答へのお礼

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

お礼日時:2009/05/13 22:02

エクセルVBAを、どれほどこなせるレベルか知ら無いが、Dictionaryなどの凝った仕組みを使わずとも、普通のVBA(ソート法などで)簡単に出来るよ。

Dictionaryの練習問題ならいざ知らず、ベテランはなるべく単純な使い慣れた仕組みを使うと思う。
Dictionaryを使いこなせるレベルなら、デバッグなど自力で出来る力が有るはずだ。
Googleででも「VBScript dictionary」で照会でもして、たくさん出る記事の適当なものを読みましたか。
ーーー
文字列を結合したKeyを作るとき、定桁結合式にしないと、おかしくなることが有ることを注意してますか。
ーーー
私の言うやり方でやってみる。
IFと代入しか使ってない。質問者は、他シート参照がなれているかな。
ただしロジックは易しいと思うが、先人のロジックで、長く使い続けて慣れた面はある。
例データ ソート後
日付数単位単価計区分
3月12日1時間200010000残業
3月12日2人1000020000通常
3月12日1人1000010000通常
3月12日4人1000010000通常
3月12日2人1000020000通常
3月14日4時間20008000残業
3月14日2人1000020000通常
3月15日4人1000040000通常
3月15日1人2000020000通常
3月15日2人2000020000通常
ーー
コード
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/121時間200010000残業
2009/3/129人1000060000通常
2009/3/144時間20008000残業
2009/3/142人1000020000通常
2009/3/154人1000040000通常
2009/3/153人2000040000通常
第1行見出しは、元のシートの見出し行をコピー貼り付けする。

この回答への補足

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

補足日時:2009/05/13 21:37
    • good
    • 0

まずはできているものを提示なさっては?


また、どのようにうまくいかないのでしょうか?

この回答への補足

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

補足日時:2009/05/13 21:45
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

教えて!goo グレード

このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング