【vba】該当するセルに別ブックのセル値の合計を反映する

vbaで該当するセルに別ブックのセル値の合計を反映させたいです。
添付画像のようなBook1Sheet1があります。
こちらの日付と種類、種類2が該当するセルをBook2Sheet2に反映したいです。
添付画像で例えますと、
Book1Sheet1の2行目と3行目のEの数をBook2Sheet2のG3に反映させたいです。この場合は「12」になります。
Book1Sheet1はどこまで行数が続くが不明なのでA列に空白がでれば、ループを抜け出すようになっています。なので、Findメソッドで該当するセルを検索し、上から順に1行ずつ処理していくようにするのが良いのかと思ったのですが、方法がわかりません。
また、Book1Sheet1で同じ日付が2行以上あったとして、Book2Sheet2に合計値を反映させることはそもそも可能なのでしょうか。
説明がわかりにくくて、申し訳ございませんが、何卒、宜しくお願い致します。

質問者からの補足コメント

• お返事ありがとうございます。
  1.マクロがあるのはbook2です。
  2.book1はxlsxです。
  3.book2はxlsmです。
  4.どちらもオープン済みです。
  5.6月のみの前提条件で大丈夫です。
  6.こちらも6月分のみで大丈夫です。
  
  宜しくお願いいたします。

  No.2の回答に寄せられた補足コメントです。 補足日時：2021/06/27 11:25

No.3 ベストアンサー 回答者： tatsumaru77 回答日時： 2021/06/27 12:06

以下のマクロを標準モジュールに登録してください。

Option Explicit

Public Sub 集計()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim maxrow1 As Long
Dim row1 As Long
Dim row2 As Long
Dim wrow As Long
Dim wcol As Long
Dim dicT As Object
Dim key As Variant
Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義
Set sh1 = Workbooks("Book1.xlsx").Worksheets("Sheet1")
Set sh2 = ThisWorkbook.Worksheets("Sheet2")
sh2.Rows("3:" & Rows.Count).ClearContents 'Sheet2の3行目以降をクリア
maxrow1 = sh1.Cells(Rows.Count, 1).End(xlUp).Row 'sheet1の最大行取得
row2 = 3
For row1 = 2 To maxrow1
key = sh1.Cells(row1, "C").Value & "|" & sh1.Cells(row1, "D").Value
If dicT.exists(key) = False Then
dicT(key) = row2
sh2.Cells(row2, "A").Value = sh1.Cells(row1, "C").Value
sh2.Cells(row2, "B").Value = sh1.Cells(row1, "D").Value
row2 = row2 + 1
End If
wcol = day(sh1.Cells(row1, "A").Value) + 2
wrow = dicT(key)
sh2.Cells(wrow, wcol).Value = sh2.Cells(wrow, wcol).Value + sh1.Cells(row1, "E").Value
Next
MsgBox ("完了")
End Sub

この回答へのお礼

お忙しい中、ありがとうございました。
とても助かりました。

お礼日時：2021/06/27 21:27

No.5 回答者： めぐみん_ 回答日時： 2021/06/27 13:48

No.4です。

ブック２のデータが多くて時間がかかっていると言うのなら、

https://officedic.com/excel-vba-app-calculation/

を参考に

Sub megu_2()
Const datash As String = "[Book1.xlsx]Sheet1!"
Dim r As Range

Application.Calculation = xlCalculationManual '自動計算停止(手動計算)

With ThisWorkbook.Worksheets("Sheet2")
Set r = Intersect(.Range("C1", .Cells(1, Columns.Count).End(xlToLeft)).EntireColumn, .Range("A3", .Cells(Rows.Count, 1).End(xlUp)).EntireRow)
End With

With r
.Formula = "=SUMIFS(" & datash & "$E:$E," & datash & "$A:$A,C$1," & datash & "$C:$C,$A3," & datash & "$D:$D,$B3)"
.Value = .Value
End With

Set r = Nothing

Application.Calculation = xlCalculationAutomatic '自動計算開始

End Sub

でしょうか？

この回答へのお礼

お忙しい中、ありがとうございました。
とても助かりました。

お礼日時：2021/06/27 21:28

No.4 回答者： めぐみん_ 回答日時： 2021/06/27 13:38

初級レベルなジジィは長いコードが書けませんので寂しかったらスル～してください。

Sub megu()
Const datash As String = "[Book1.xlsx]Sheet1!"
Dim r As Range

With ThisWorkbook.Worksheets("Sheet2")
Set r = Intersect(.Range("C1", .Cells(1, Columns.Count).End(xlToLeft)).EntireColumn, .Range("A3", .Cells(Rows.Count, 1).End(xlUp)).EntireRow)
End With

With r
.Formula = "=SUMIFS(" & datash & "$E:$E," & datash & "$A:$A,C$1," & datash & "$C:$C,$A3," & datash & "$D:$D,$B3)"
.Value = .Value
End With

Set r = Nothing

End Sub

No.2 回答者： tatsumaru77 回答日時： 2021/06/27 11:17

補足要求です。

１．マクロがあるのはどちら側のブックですか。
２．Book1の拡張子は何でしょうか。(xlsm,xlsxのどちらでしょうか)
３．Book2の拡張子は何でしょうか。(xlsm,xlsxのどちらでしょうか)
４．Book1,Book2ともにオープン済みという前提で良いのですか。
５．Book1のSheet1には2021年６月の日付のみという前提で良いのですか。それとも他の月のデータも
あるのですか。
６．Book２のSheet2は6/1～6/30の６月分のみという前提でよいですか。それとも、
右側に７月，８月，９月などがあるのですか。

No.1 回答者： めぐみん_ 回答日時： 2021/06/27 10:55

数式ならSUMIFS関数でも行けそうですけどね。

＞また、Book1Sheet1で同じ日付が2行以上あったとして、Book2Sheet2に合計値を反映させることはそもそも可能なのでしょうか。

そこは問題ないと初級レベルなジジィは思います。（エクセル入ってないですが）

この回答へのお礼

お返事ありがとうございます。
関数だと不都合が生じてしまう場合があり、VBAで行う条件になっております。

お礼日時：2021/06/27 11:27