エクセル 同一の項目をまとめる方法を教えてください

下記の表でA列（店名）とB列（品物）が同一の時にまとめてD列に品名、E列に合計金額を記入したいと思っています。D,E列はA列_各店名の最初の行から、B列の品物順で記入したいです。
現在はフィルタで絞って重複削除し、D列へ貼り付け、E列はSUMIFで計算しています。
Unique関数は使用できません。VBAも少し理解しています。
店名、品物が多いため、効率的なやり方を教えていただけないでしょうか。
どうぞよろしくお願いいたします。

A B C D E
店名 品物 金額 品物別合計 金額
A店 みかん 110 みかん 330
A店 りんご 150 りんご 280
A店 みかん 100
A店 みかん 120
A店 りんご 130
B店 いちご 300 いちご 700
B店 りんご 150 りんご 150
B店 みかん 120 みかん 220
B店 いちご 400
B店 みかん 100

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

• マクロ勉強中のため、大変勉強になります。ありがとうございます！
  D、E列は各店ごとに上段から詰めて入力したいのですが、
  下記の右図のようにする方法があれば教えていただけないでしょうか。

  
  No.2の回答に寄せられた補足コメントです。 補足日時：2021/03/04 14:57

• 説明不足で申し訳ありません。各店は必ずひとかたまりになっています。

  No.5の回答に寄せられた補足コメントです。 補足日時：2021/03/04 22:43

No.8 ベストアンサー 回答者： tatsumaru77 回答日時： 2021/03/04 22:50

No2です。

以下のようにしてください。

Option Explicit
Public Sub 店別品物別合計()
Dim dicT As Object
Dim sh As Worksheet
Dim prev As String
Dim maxrow As Long
Dim wrow As Long
Dim srow As Long
Dim grow As Long
Dim key As String
Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義
Set sh = ActiveSheet
maxrow = sh.Cells(Rows.Count, 1).End(xlUp).Row 'Sheet A列最終行を求める
sh.Range("D2:E" & maxrow).Value = "" 'D、E列クリア
prev = ""
srow = 2
For wrow = 2 To maxrow
If prev <> sh.Cells(wrow, "A").Value Then
dicT.RemoveAll
srow = wrow
End If
key = sh.Cells(wrow, "B").Value
If dicT.exists(key) = False Then
dicT(key) = srow
sh.Cells(srow, "D").Value = sh.Cells(wrow, "B").Value '品物設定
srow = srow + 1
End If
grow = dicT(key)
sh.Cells(grow, "E").Value = sh.Cells(grow, "E").Value + sh.Cells(wrow, "C").Value '金額加算
prev = sh.Cells(wrow, "A").Value
Next
MsgBox ("完了")
End Sub

この回答へのお礼

大変助かりました。本当にありがとうございます！

お礼日時：2021/03/04 23:02

No.7 回答者： mike_g 回答日時： 2021/03/04 20:48

[No.6]誤謬訂正m(_._)m

G列のデータを添附圖の樣に訂正します。

この回答へのお礼

本当にありがとうございます！

お礼日時：2021/03/04 22:58

No.6 回答者： mike_g 回答日時： 2021/03/04 18:11

[No.3お礼]へのコメント、

》 さらにD,E列は店舗ごとに上段から
》 詰めて入力したいと思っています
此処の添附圖の樣にね。實は、其れが私好みなんだけど、ハナレバナレ愛する貴方は風變はりな人と思ってました。(^_^)

K2: =SMALL(IF($J$2:$J$11=1,ROW(J$2:J$11)),ROW(A1))
￣￣【御斷はり】上式は必ず配列數式として入力の事

この回答へのお礼

本当にありがとうございます！とても参考になります。関数自体はわかっているつもりなのに、なくなかなか自分で応用出来るようになりません。。もっと勉強します！

お礼日時：2021/03/04 22:56

No.5 回答者： tatsumaru77 回答日時： 2021/03/04 16:17

＞D、E列は各店ごとに上段から詰めて入力したいのですが、

＞下記の右図のようにする方法があれば教えていただけないでしょうか。
各店は、必ずひとかたまりになっていますか？
つまり、
A2=A店
A3=A店
A4=A店
A5=B店
A6=B店
A7=A店・・・・このようなケース
は絶対ないのでしょうか。

No.4 回答者： fujillin 回答日時： 2021/03/04 09:33

こんにちは

D列が求められれば、E列の式はそのままでもよさそうに思いましたので、D列のみの回答です。

＞効率的なやり方を教えていただけないでしょうか。
関数で直接求める方式なので、必ずしも「効率がよい」とは言えませんが、行数がそれほど大きくなければ気にならないと思います。

D2セルに
=IF(ISERROR(MATCH(ROW(A2),INDEX(ROW(A$2:A$999)/(COUNTIFS(OFFSET(A$1,,,ROW(A$2:A$999)),A$2:A$999,OFFSET(B$1,,,ROW(A$2:A$999)),B$2:B$999)=1),),0)),"",B2)

の式を入力して、下方に必要な範囲までフィルコピーではいかがでしょうか？

この回答へのお礼

このようなやり方もあるのですね。大変参考になりました。ありがおうございます

お礼日時：2021/03/04 14:58

No.3 回答者： mike_g 回答日時： 2021/03/03 21:20

セル G2、H2 に夫々式 =A2&"_"&B2、=COUNTIF(G$2:G2,G2) を

入力⇒範圍 G2:H2 を下方にズズーッと(11行目迄)オートフィル⇒
セル D2、E2 に夫々式
=IF(H2=1,B2,"")
=IF(D2="","",SUMIFS(C$2:C$11,A$2:A$11,A2,B$2:B$11,B2))
を入力⇒範圍 D2:E2 を下方にズズーッと(11行目迄)オートフィル
オ・シ・マ・イ

この回答へのお礼

G列にこのように表記すればよいのですね。とても参考になりました。
ありがとうございます。
私の例文が悪かったのですが、さらにD,E列は店舗ごとに上段から詰めて入力したいと思っています。同一の品物が続いた時に、空白をとらないようにする方法をさらに考えてみたいと思います。本当にありがとうございました。

お礼日時：2021/03/04 15:16

No.2 回答者： tatsumaru77 回答日時： 2021/03/03 19:21

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

Option Explicit
Public Sub 店別品物別合計()
Dim dicT As Object
Dim sh As Worksheet
Dim maxrow As Long
Dim wrow As Long
Dim grow As Long
Dim key As String
Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義
Set sh = ActiveSheet
maxrow = sh.Cells(Rows.Count, 1).End(xlUp).Row 'Sheet A列最終行を求める
sh.Range("D2:E" & maxrow).Value = "" 'D、E列クリア
For wrow = 2 To maxrow
key = sh.Cells(wrow, "A").Value & "|" & sh.Cells(wrow, "B").Value
If dicT.exists(key) = False Then
dicT(key) = wrow
sh.Cells(wrow, "D").Value = sh.Cells(wrow, "B").Value '品物設定
End If
grow = dicT(key)
sh.Cells(grow, "E").Value = sh.Cells(grow, "E").Value + sh.Cells(wrow, "C").Value '金額加算
Next
MsgBox ("完了")
End Sub

No.1 回答者： fxq11011 回答日時： 2021/03/03 19:13

参考

まったく別の列（例えばD列）に品名を入力した置きます。
E列にSUMIF関数を入力、範囲指定は、品物（B列）・金額（C列）、合計する範囲は金額（C列）、※範囲指定は店舗ごとの各列それぞれ全行を指定。
これを入力して、相対参照のまま下の行へコピーすればOK。
店舗ごとに上の作業が必要になります。

この回答へのお礼

とても参考になりました。ありがとうございました。

お礼日時：2021/03/04 15:10