ｖｂａ 3つの条件が一致したら数値を合算する

ｖｂａ初心者です。
データから必要なものだけを抽出して並べ替えるところまで進んだのですが、途中の段階でつまづいて中々前に進めません。毎週末にネットを見ながら進めてはいるのですがどうしても分かりません。お助けいただけると嬉しいです。

Ｓｈｅｅｔ１にデータがあります。Ａ列とＢ列をＣ列が一致した場合のみ、Ｄ列の数値を合算したいのです。Ａ列とＢ列とＣ列は、事前に並べ替えており値は順番に揃っています。また、途中で空白行はありません。Ｓｈｅｅｔ１で合算したデータはＳｈｅｅｔ2に反映をしたいです。

添付画像の左側がＳｈｅｅｔ１で、処理をした後右側のデータに変換してＳｈｅｅｔ２に反映したいです。よろしくお願いします。

No.3 ベストアンサー 回答者： tom04 回答日時： 2018/03/11 00:10

No.2です。

＞2018/03/15　13：00、2018/03/15　15：00といったデータを・・・

あぁ～～～
日付は同じでも別物になりますね。
一案ですが、

Sheet1のC列（日付列）にはそのまま時刻があってもよいので、表示形式だけを変更し

前回のコードの
＞myStr = myR(i, 1) & "_" & myR(i, 2) & "_" & myR(i, 3)
を
＞myStr = myR(i, 1) & "_" & myR(i, 2) & "_" & Int(myR(i, 3))
に変更してみてはどうでしょうか？

ただし、Sheet2の方には時刻は表示されません。m(_ _)m

この回答へのお礼

本当にありがとうございます。
3週間前からずっと合算できないかと、毎週末空き時間にパソコンの前に座って考えていました。相当な時間がかかってもできなかったので、最後にこちらで質問させていただきました。

諦めかけていたのですが、完璧なコードを教えていただきありがとうございます。時刻の件も解決してもらいありがとうございます。

本を買い、ネットで調べ解決しなかったことが数時間で解決して驚いております。

お礼日時：2018/03/11 00:23

No.2 回答者： tom04 回答日時： 2018/03/10 23:30

こんばんは！

一例です。
標準モジュールにしてください。

Sub Sample1()
Dim myDic As Object
Dim i As Long, lastRow As Long
Dim myStr As String, wS As Worksheet
Dim myKey, myItem, myR, myAry

Set myDic = CreateObject("Scripting.Dictionary")
Set wS = Worksheets("Sheet2")
wS.Range("A:D").ClearContents
With Worksheets("Sheet1")
wS.Range("A1:D1").Value = .Range("A1:D1").Value
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
myR = Range(.Cells(2, "A"), .Cells(lastRow, "D"))
For i = 1 To UBound(myR, 1)
myStr = myR(i, 1) & "_" & myR(i, 2) & "_" & myR(i, 3)
If Not myDic.exists(myStr) Then
myDic.Add myStr, myR(i, 4)
Else
myDic(myStr) = myDic(myStr) + myR(i, 4)
End If
Next i
End With
myKey = myDic.keys
myItem = myDic.items
For i = 0 To UBound(myKey)
myAry = Split(myKey(i), "_")
With wS.Cells(i + 2, "A")
.Value = myAry(0)
.Offset(, 1) = myAry(1)
.Offset(, 2) = myAry(2)
.Offset(, 3) = myItem(i)
End With
Next i
Set myDic = Nothing
'//▼ココから並び替え//
wS.Range("A1").CurrentRegion.Sort key1:=wS.Range("A1"), order1:=xlAscending, Header:=xlYes, _
key2:=wS.Range("C1"), order1:=xlAscending, Header:=xlYes
wS.Activate
MsgBox "完了"
End Sub

※　Sheet2のC列（日付列）の表示形式はあらかじめ好みの表示形式にしておいてください。

※　Sheet1のデータの並び替えは不要です。（バラバラのデータでOK）
最後にSheet2で並び替えを行っています。m(_ _)m

この回答へのお礼

早速のお返事ありがとうございます。
試してみたのですが、うまくいかったです。

ｖｂａのコードは問題ないと思うのですが、こちらのデータに問題があり今悩み中です。2018/03/15　13：00、2018/03/15　15：00といったデータをｖｂａで3月15日に変更していて表面上は同じですが、内部のデータが異なっているため合算しなかったと思われます。

ご丁寧に本当にありがとうございます。

お礼日時：2018/03/10 23:56

No.1 回答者： 午後の紅茶おいしい無糖 回答日時： 2018/03/10 23:03

私も以前同じような質問をした事があります。

ピボットテーブルではダメでしょうか？
このような感じになりますが、、、。

この回答へのお礼

早速のお返事ありがとうございます。
説明不足で申し訳ありません。
その後、合算した表をいくつかのシートにデータを分散して表を再作成しようと考えています。ピボットテーブルにしていまうとその後の作業ができなくなりますので、エクセルの通常のデータが嬉しいです。

回答いただきましてありがとうございます。

お礼日時：2018/03/10 23:16