EXCELで２列のセルを結合して検索し合計値を表示させたい

質問

EXCELで下記のようなファイルがあります。

【シート１】
A B
45 10
25 27　*
74 48
47 14
95 28　*
21 21

【シート２】
A B
57 20
47 54　*
13 321
71 61

【シート３】
A B Total
25 27 4873　　---シート１
47 54 4740　　---シート２
95 28 541　　 ---シート１

【シート３】のA列＆B列は必ず
【シート１】のA列＆B列か
【シート２】のA列＆B列にあります。
※重複はありません。

【シート３】のA列＆B列をキーにして
【シート１】のA列＆B列と
【シート２】のA列＆B列を検索し、

【シート１】の合計をセルＦ２に
【シート２】の合計をセルＧ２に
表示させたいのですが。

結果表示：
【シート３】
A B Total
25 27 4873　　5414　　4740
47 54 4740
95 28 541

説明がわかりづらくてすみません。補足していきますので説明不足なところがありましたらご指摘ください。

セルを結合したりVLOOKUPを使ったりしたのですが、
式を入力する列が増えてしまいました。
もう少しすっきりできないものでしょうか？

それとマクロでもできる方法がありましたら
是非教えてください。都合その方が助かります。

よろしくお願いします。

回答No.4

ja7awu

#３ですが、ちょっと追加です。

データの中に文字列が入っていても、エラーにならないようにしました。
見出し行が何行あってもいいように、データの先頭行を指定するように
しました。　コードの５行目で指定してください。

比較区分するデータが数値だけの場合は、こちらをお使いください。

もし、比較区分するデータが文字列も有効にするのであれば、前のコードを
使って、下記行の "A1" の部分を見出しを除いたデータの先頭行（例えば "A2"）
に変更してください。

For Each Rng In Range("A1", Range("A65536").End(xlUp))

Sub 区分集計()
Const sh1 = "シート１" ' <---- シート名を指定
Const sh2 = "シート２" ' <---- 　　〃
Const sh3 = "シート３" ' <---- 区分合計を記入するシート名
Const TopRow = 2 ' <--------- データの先頭行（見出しを除く）
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Dim Ws3 As Worksheet
Dim Rng As Range
Dim R As Range
Dim N As Integer
Dim First As String
Dim Val1 As Double, Val2 As Double
For N = 1 To Worksheets.Count
　　If Worksheets(N).Name = sh1 Then
　　　　Set Ws1 = Worksheets(N)
　　ElseIf Worksheets(N).Name = sh2 Then
　　　　Set Ws2 = Worksheets(N)
　　ElseIf Worksheets(N).Name = sh3 Then
　　　　Set Ws3 = Worksheets(N)
　　End If
Next N
If Ws1 Is Nothing Or Ws2 Is Nothing Or Ws3 Is Nothing Then
　　MsgBox "指定したシートが存在しません。"
　　Exit Sub
End If
Ws3.Select
For Each Rng In Range("A" & TopRow, Range("A65536").End(xlUp))
　　If IsNumeric(Rng) And IsNumeric(Rng.Offset(, 1)) Then
　　　　Set R = Ws1.Range("A:A").Find(Rng.Value, lookat:=xlWhole)
　　　　If Not R Is Nothing Then
　　　　　　First = R.Address
　　　　　　Do
　　　　　　　　If Rng.Offset(, 1).Value = R.Offset(, 1).Value Then
　　　　　　　　　　Val1 = Val1 + Rng.Offset(, 2).Value
　　　　　　　　　　Exit Do
　　　　　　　　End If
　　　　　　　　Set R = Ws1.Range("A:A").FindNext(R)
　　　　　　Loop Until R Is Nothing Or R.Address = First
　　　　End If
　　　　Set R = Ws2.Range("A:A").Find(Rng.Value, lookat:=xlWhole)
　　　　If Not R Is Nothing Then
　　　　　　First = R.Address
　　　　　　Do
　　　　　　　　If Rng.Offset(, 1).Value = R.Offset(, 1).Value Then
　　　　　　　　　　Val2 = Val2 + Rng.Offset(, 2).Value
　　　　　　　　　　Exit Do
　　　　　　　　End If
　　　　　　　　Set R = Ws2.Range("A:A").FindNext(R)
　　　　　　Loop Until R Is Nothing Or R.Address = First
　　　　End If
　　End If
Next Rng
Range("F2").Value = Val1
Range("G2").Value = Val2
Set Ws1 = Nothing: Set Ws2 = Nothing
Set Ws3 = Nothing: Set R = Nothing
Beep: Beep: Beep
MsgBox "区分集計完了!!"
End Sub

お礼

ありがとうございました。
文字列版，数値版ともに試してみましたが希望どおりの結果が得られました。
わかりづらい説明にも関わらず、回答して頂きありがとうございました。
本当に助かりました。

回答No.3

ja7awu

次のマクロを実行するとご希望どおりの合計値が所定のセルに表示されます。

一応、詳しい手順を書いておきますが、ご存知でしたら、読み飛ばしてください。

[操作手順]

１．Alt + F11 で VBE(Visual Basic Editor)を開きます。
２．VBE のメニューから[挿入] -->[標準モジュール] を指定します。
３．モジュールウィンドウに下記コードをコピーして貼り付けます。
　　必要により１～３行目のシート名を変更します。
４．Alt + Q （または、右上隅の×）でウィンドウを閉じ、シートに戻ります。
５．メニューから[ツール]-->[マクロ]-->[セキュリティ]で「セキュリティレベル」を
　「中」にして[OK]します。
６．実行するときは、Alt ＋ F8 (メニューから[ツール]-->[マクロ]-->[マクロ])で
　「区分集計」を指定し、[実行]ボタンを押します。

Sub 区分集計()
Const sh1 = "シート１" ' <---- シート名を指定（全/半角 注意!!）
Const sh2 = "シート２" ' <---- 　　〃
Const sh3 = "シート３" ' <---- 区分合計を記入するシート名
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Dim Ws3 As Worksheet
Dim Rng As Range
Dim R As Range
Dim N As Integer
Dim First As String
Dim Val1 As Double, Val2 As Double
For N = 1 To Worksheets.Count
　　If Worksheets(N).Name = sh1 Then
　　　　Set Ws1 = Worksheets(N)
　　ElseIf Worksheets(N).Name = sh2 Then
　　　　Set Ws2 = Worksheets(N)
　　ElseIf Worksheets(N).Name = sh3 Then
　　　　Set Ws3 = Worksheets(N)
　　End If
Next N
If Ws1 Is Nothing Or Ws2 Is Nothing Or Ws3 Is Nothing Then
　　MsgBox "指定したシートが存在しません。"
　　Exit Sub
End If
Ws3.Select
For Each Rng In Range("A1", Range("A65536").End(xlUp))
　　Set R = Ws1.Range("A:A").Find(Rng.Value, lookat:=xlWhole)
　　If Not R Is Nothing Then
　　　　First = R.Address
　　　　Do
　　　　　　If Rng.Offset(, 1).Value = R.Offset(, 1).Value Then
　　　　　　　　Val1 = Val1 + Rng.Offset(, 2).Value
　　　　　　　　Exit Do
　　　　　　End If
　　　　　　Set R = Ws1.Range("A:A").FindNext(R)
　　　　Loop Until R Is Nothing Or R.Address = First
　　End If
　　Set R = Ws2.Range("A:A").Find(Rng.Value, lookat:=xlWhole)
　　If Not R Is Nothing Then
　　　　First = R.Address
　　　　Do
　　　　　　If Rng.Offset(, 1).Value = R.Offset(, 1).Value Then
　　　　　　　　Val2 = Val2 + Rng.Offset(, 2).Value
　　　　　　　　Exit Do
　　　　　　End If
　　　　　　Set R = Ws2.Range("A:A").FindNext(R)
　　　　Loop Until R Is Nothing Or R.Address = First
　　End If
Next Rng
Range("F2").Value = Val1
Range("G2").Value = Val2
Set Ws1 = Nothing: Set Ws2 = Nothing: Set Ws3 = Nothing
End Sub

回答No.2

imogasi

？Ａ列Ｂ列は数字が入っているのですか。
？Ａ列、Ｂ列の数字の最高桁数は３桁と考えて良いでしょうか。
？シート１とシート２のＣ列には「Ｔｏｔａｌ」と称する
数字が予め入っているのでしょうね。（＃１のご質問とも関連）
－－－－
Ａ列、Ｂ列のデータを＝Ａ１＆Ｂ１なんてやってませんか。桁数をそろえて=TEXT(A1,"000")&TEXT(B1,"000")のようにＣ１等に作ります。シート１、シート２とも。
さらにシート３にも同様の文字列をＣ列等に作ります。
Ｓｈｅｅｔ１
（Ａ）　（Ｂ）　　（Ｃ）　　（Ｄ）
1 2 001002 34
００１００２は３４より左列に来ること。
Ｓｈｅｅｔ３で
（Ａ）　（Ｂ）　　（Ｃ）
1 2 001002
でＤ１に=VLOOKUP(C1,Sheet1!$C$1:$D$10,2,FALSE)
を入れて３４を取ってきました。
Sheet1に見つからない時のことも考え、Ｆ１列にも
Ｓｈｅｅｔ２を対象としたＶＬＯＯＫＵＰ関数を入れる。
見つからない時のために本当は、Ｄ、Ｆ列の関数式ともＩＳＥＲＲＯＲ等の手当てをする。

回答No.1

comv

こんばんは

複数条件で検索するのはわかるのですが

>【シート１】の合計をセルＦ２に
>【シート２】の合計をセルＧ２に
合計とは？　どの部分を合計するのでしょうか？

補足

>>合計とは？　どの部分を合計するのでしょうか？
合計はシート３の「Total」のことです。