Excel 複数行の同じような商品を１行目にまとめ

質問

同じような商品が入力された複数行を１行にまとめ合計を出す方法を教えてください。

エクセルの表でA列に商品名B列C列には金額、個数、似たような商品が、複数行にランダムに掲載されています。

Ａ列には商品名（メーカー名や種類）の情報を持つ商品について

元データ
A1：Panasonic　　　　　　B1：1　C1：2
A2：パナソニック　　　　 B2：1　C2：2
A3: TOSHIBA　　　　　　　B3：2　C3：3
A4: 東芝 エアコン　　　　B4：2　C4：3
A5: mitsubishi　　　　　 B5：3　C5：4
A6: 三菱 エアコン B6：3　C6：4
A7: MITSUBISHI　　　　　 B7：3　C7：4

完成データ
A1：Panasonic,パナソニック　　　　　 　　B1：2　C1：4
A2：TOSHIBA,東芝 エアコン 　　　　　 　　B2：4　C2：6
A3：mitsubishi,三菱 エアコン,MITSUBISHI B3：9　C2：12

条件としては、シート２のメーカー名の一覧を元に含まれていれば同じ内容として、
カンマ区切りで一行にまとめたいです。

わかる方教えて頂けないでしょうか。
Excelは2003です。

回答No.7

tom04 · ベストアンサー

続けてお邪魔します。

＞こちらのコードで、シート２のメーカー名にない場合は、
＞シート３には表示しないようになっているようにみえるですが、
＞こちらをシート２のメーカー名にない場合そのままシート１の
＞表記をだすようにできますでしょうか。

最初の質問にはそういった条件はなかったので、Sheet1のA列データはSheet2のA列にあるものとして考えていました。

＞また、シート１のＢ列からの計算列を増やすことは可能でしょうか

実際のデータが何列目まであるのか判らないので、とりあえず何列でも対応できるようにしています。
尚、最初の質問ではSheet1・Sheet2のデータは1行目からあるように書かれていますが、
補足では1行目は項目行でデータは2行目以降にあるものと思われますので、
Sheet1も1行目は項目で、実データは2行目以降にあるとしています。

そして、Sheet1の1行目で最終列を取得していますので、
Sheet1の1行目は最終列まで何らかのデータが入っているという前提です。
（足し算をしていますので、Sheet1のB列以降は数値データとします）

Sub Sample4()
Dim i As Long, j As Long, lastCol As Long, lastRow As Long
Dim c As Range, r As Range
Dim wS1 As Worksheet, wS2 As Worksheet, wS3 As Worksheet
Set wS1 = Worksheets("Sheet1")
Set wS2 = Worksheets("Sheet2")
Set wS3 = Worksheets("Sheet3")
Application.ScreenUpdating = False
lastCol = wS1.Cells(1, Columns.Count).End(xlToLeft).Column
lastRow = wS3.Cells(Rows.Count, "A").End(xlUp).Row
If lastRow > 1 Then
Range(wS3.Cells(2, "A"), wS3.Cells(lastRow, lastCol)).ClearContents
End If
wS3.Range("A:A").Insert
On Error Resume Next
For i = 2 To wS1.Cells(Rows.Count, "A").End(xlUp).Row '←2行目からSheet1の最終行まで
Set c = wS2.Range("A:A").Find(what:=wS1.Cells(i, "A"), LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
wS1.Cells(i, "A").Resize(, lastCol).Copy wS3.Cells(Rows.Count, "B").End(xlUp).Offset(1)
Else
Set r = wS3.Range("A:A").Find(what:=c.Offset(, 1), LookIn:=xlValues, lookat:=xlWhole)
If r Is Nothing Then
wS3.Cells(Rows.Count, "B").End(xlUp).Offset(1, -1) = c.Offset(, 1)
wS1.Cells(i, "A").Resize(, lastCol).Copy wS3.Cells(Rows.Count, "B").End(xlUp).Offset(1)
Else
If InStr(r.Offset(, 1), wS1.Cells(i, "A")) = 0 Then
r.Offset(, 1) = r.Offset(, 1) & "," & wS1.Cells(i, "A")
End If
For j = 2 To lastCol
With wS3.Cells(r.Row, j + 1)
.Value = .Value + wS1.Cells(i, j)
End With
Next j
End If
End If
Next i
wS3.Range("A:A").Delete
wS3.Columns.AutoFit
Application.ScreenUpdating = True
End Sub

今度はどうでしょうか？m(_ _)m

お礼

細かな要望まで対応して頂きありがとうございます！
一旦確認して見ます。

回答No.6

tom04

No.3・4です。
補足を拝見しました。
Sheet2の配置が全く異なっていたので、意味のないコードになってしまいましたね。

↓のコードに変更してマクロを実行してみてください。
操作方法はNo.3の説明通りです。

Sub Sample3() 'この行から
Dim i As Long, lastRow As Long
Dim c As Range, r As Range, myRange As Range
Dim wS1 As Worksheet, wS2 As Worksheet, wS3 As Worksheet
Set wS1 = Worksheets("Sheet1")
Set wS2 = Worksheets("Sheet2")
Set wS3 = Worksheets("Sheet3")
lastRow = wS3.Cells(Rows.Count, "A").End(xlUp).Row
If lastRow > 1 Then
Range(wS3.Cells(2, "A"), wS3.Cells(lastRow, "C")).ClearContents
End If
wS3.Range("A:A").Insert
On Error Resume Next '←念のため
For i = 1 To wS1.Cells(Rows.Count, "A").End(xlUp).Row
Set c = wS2.Range("A:A").Find(what:=wS1.Cells(i, "A"), LookIn:=xlValues, lookat:=xlWhole)
Set r = wS3.Range("A:A").Find(what:=c.Offset(, 1), LookIn:=xlValues, lookat:=xlWhole)
If r Is Nothing Then
With wS3.Cells(Rows.Count, "A").End(xlUp).Offset(1)
.Value = c.Offset(, 1)
.Offset(, 1) = wS1.Cells(i, "A")
.Offset(, 2) = wS1.Cells(i, "B")
.Offset(, 3) = wS1.Cells(i, "C")
End With
Else
Set myRange = wS3.Range("A:A").Find(what:=r, LookIn:=xlValues, lookat:=xlWhole)
With myRange.Offset(, 1)
If InStr(.Value, wS1.Cells(i, "A")) = 0 Then
.Value = .Value & "," & wS1.Cells(i, "A")
End If
.Offset(, 1) = .Offset(, 1) + wS1.Cells(i, "B")
.Offset(, 2) = .Offset(, 2) + wS1.Cells(i, "C")
End With
End If
Next i
wS3.Range("A:A").Delete
wS3.Columns.AutoFit
End Sub 'この行まで

こんどはどうでしょうか？m（_ _）m

補足

tom04さん

早速作って頂いてありがとうございます。
こちらのコードで、シート２のメーカー名にない場合は、
シート３には表示しないようになっているようにみえるですが、
こちらをシート２のメーカー名にない場合そのままシート１の
表記をだすようにできますでしょうか。

また、シート１のＢ列からの計算列を増やすことは可能でしょうか。

回答No.5

kagakusuki

今仮に、元データがSheet1に入力されていて、Sheet2のA列～B列にメーカー名の一覧表が作成されていて、Sheet2のD列～H列を作業列として使用して、Sheet3に完成データの表を表示させるものとします。
　又、元データの商品名欄において、例えば「東芝 エアコン」の様にメーカー名以外の文字列も併記される場合には、必ず、メーカー名が先頭に来る様になっていて、尚且つ、メーカー名と商品名の間には、必ず空白スペースが挟まっているものとします。
　尚、処理の都合がありますので、Sheet1の1行目は項目名等を入力するために使用するものとし、実際の元データはSheet1の2行目以下に入力されているものとします。

　まず、Sheet2のA2以下に「パナソニック」や「東芝」、「mitsubishi」といった、商品名の頭に付けられている「メーカー名を示す文字列」(商品名の中の空白スペースよりも前の部分)を入力して下さい。
　但し、Sheet2のA列にメーカー名を入力する際には、片仮名やアルファベットは全て半角文字で入力し、アルファベットは全て小文字で入力する様にして下さい。(漢字や平仮名の様に、半角文字が存在しない文字のみ、全角文字で入力する様にして下さい)
　次に、隣の列であるSheet2のB列には「パナソニック」、「東芝」、「三菱」といった、Sheet2のA列に入力されている「商品名の頭に付けられている『メーカー名を示す文字列』」に対応する「メーカー名」を入力して下さい。
　こちらは、メーカーごとに統一されてさえいれば、半角/全角、大文字/小文字は問いませんし、
例えば
Panasonic→メーカーA
東芝→メーカーT
三菱→メーカー3
という具合に、実際のメーカー名とは無関係な文字列であっても構いません。

　次に、Sheet2のD2セルに次の関数を入力して下さい。

=IF(INDEX(Sheet1!$A:$A,ROW())="","",INDEX(Sheet1!$A:$A,ROW()))

　次に、Sheet2のE2セルに次の関数を入力して下さい。

=IF($D2="","",$D2&"◆"&SUMPRODUCT(2^(ROW(INDIRECT("Z1:Z"&LEN($D2)))-1)*EXACT(MID(UPPER($D2),ROW(INDIRECT("Z1:Z"&LEN($D2))),1),MID($D2,ROW(INDIRECT("Z1:Z"&LEN($D2))),1))))

　次に、Sheet2のG2セルに次の関数を入力して下さい。

=IF(ISNUMBER(1/COUNTIF($A:$A,LEFT(LOWER(ASC($D2)),FIND(" ",ASC($D2)&" ")-1))/($D2<>"")),VLOOKUP(LEFT(LOWER(ASC($D2)),FIND(" ",ASC($D2)&" ")-1),$A:$B,2,FALSE)&"◆"&COUNTIF(G$1:G1,VLOOKUP(LEFT(LOWER(ASC($D2)),FIND(" ",ASC($D2)&" ")-1),$A:$B,2,FALSE)&"◆*?")+1,"")

　次に、Sheet2のF2セルに次の関数を入力して下さい。

=IF(COUNTIF($G2,"*?◆*?"),IF($G2=LEFT($G2,FIND("◆",$G2))&COUNTIF($G:$G,LEFT($G2,FIND("◆",$G2))&"*?"),MATCH(LEFT($G2,FIND("◆",$G2))&1,$G:$G,0),""),"")

　次に、Sheet2のH2セルに次の関数を入力して下さい。

=IF(COUNTIF($G2,"*?◆*?"),IF(COUNTIF($E$1:$E2,$E2)=1,IF(COUNTIF($G2,"*?◆1"),"",VLOOKUP(LEFT($G2,FIND("◆",$G2))&COUNTIF($G$1:$G1,LEFT($G2,FIND("◆",$G2))&"*?"),$G:$H,2,FALSE)&",")&$D2,""),"")

　次に、Sheet2のD2～H2の範囲をコピーして、同じ列範囲の3行目以下に貼り付けて下さい。(元データの表の枠線が引かれている一番下の行番号と同じ行番号の行の所まで)

　次に、Sheet3のA2セルに次の関数を入力して下さい。

=IF(ROWS($2:2)>COUNT(Sheet2!$F:$F),"",VLOOKUP(SMALL(Sheet2!$F:$F,ROWS($2:2)),Sheet2!$F:$H,3,FALSE))

　次に、Sheet3のB2セルに次の関数を入力して下さい。

=IF($A2="","",SUMIF(Sheet2!$G:$G,SUBSTITUTE(INDEX(Sheet2!$G:$G,SMALL(Sheet2!$F:$F,ROWS($2:2))),"◆1","◆*"),Sheet1!$B:$B))

　次に、Sheet3のC2セルに次の関数を入力して下さい。

=IF($A2="","",SUMIF(Sheet2!$G:$G,SUBSTITUTE(INDEX(Sheet2!$G:$G,SMALL(Sheet2!$F:$F,ROWS($2:2))),"◆1","◆*"),Sheet1!$C:$C))

　次に、Sheet3のA2～C2の範囲をコピーして、同じ列範囲の3行目以下に貼り付けて下さい。(メーカーの数を上回るのに十分な行数となるまで)

　以上です。

回答No.4

tom04

No.3です。
たびたびごめんなさい。

前回のコードではSheet1のA列に同じものが複数回出現する場合
ちゃんと対応できません。
前回のコードはすべて削除して↓のコードに変更してください。

Sub Sample2() 'この行から
Dim i As Long, j As Long, lastRow As Long
Dim c As Range, r As Range, myRange As Range
Dim wS1 As Worksheet, wS2 As Worksheet, wS3 As Worksheet
Set wS1 = Worksheets("Sheet1")
Set wS2 = Worksheets("Sheet2")
Set wS3 = Worksheets("Sheet3")
lastRow = wS3.Cells(Rows.Count, "A").End(xlUp).Row
If lastRow > 1 Then
Range(wS3.Cells(2, "A"), wS3.Cells(lastRow, "C")).ClearContents
End If
wS3.Range("A:A").Insert
On Error Resume Next '←念のため
For i = 1 To wS1.Cells(Rows.Count, "A").End(xlUp).Row
Set c = wS2.Cells.Find(what:=wS1.Cells(i, "A"), LookIn:=xlValues, lookat:=xlWhole)
j = c.Column
Set r = wS3.Range("A:A").Find(what:=j, LookIn:=xlValues, lookat:=xlWhole)
If r Is Nothing Then
With wS3.Cells(Rows.Count, "A").End(xlUp).Offset(1)
.Value = j
.Offset(, 1) = wS1.Cells(i, "A")
.Offset(, 2) = wS1.Cells(i, "B")
.Offset(, 3) = wS1.Cells(i, "C")
End With
Else
Set myRange = wS3.Range("A:A").Find(what:=j, LookIn:=xlValues, lookat:=xlWhole)
With myRange.Offset(, 1)
If InStr(myRange.Offset(, 1), wS1.Cells(i, "A")) = 0 Then
.Value = .Value & "," & wS1.Cells(i, "A")
End If
.Offset(, 1) = .Offset(, 1) + wS1.Cells(i, "B")
.Offset(, 2) = .Offset(, 2) + wS1.Cells(i, "C")
End With
End If
Next i
wS3.Range("A:A").Delete
wS3.Columns.AutoFit
End Sub 'この行まで

何度も失礼しました。m(_ _)m

補足

tom04さん　
わざわざマクロコードを作っていただきありがとうございます！
説明不足で申し訳ございませんでした。
シート２のメーカー名なんですが、
A列にメーカー名
B列にそれに紐づくメーカー番号を入れています。

↓下記のような表です。
A1：　　　　　メーカー名　　　　　B1：　　　　　メーカーコード
A2：　　　　　Panasonic　　　　　 B2：　　　　　1001
A3: 　　　　　パナソニック　　　 B3：　　　　　1001
A4: 　　　　　TOSHIBA　　　　 　B4：　　　　　1002
A5: 　　　　　東芝 エアコン　 　B5：　　　　　1002
A6: 　　　　　mitsubishi　　　　　B6：　　　　　1003
A7: 　　　　　三菱 エアコン　 B7：　　　　　1003
A8:　　　　　MITSUBISHI　　　　 　B8：　　　　　1003

これを元にできないでしょうか。
作っていただいてからで恐縮ですがよろしくおねがいします。

回答No.3

tom04

こんばんは！

＞条件としては、シート２のメーカー名の一覧を元に・・・

の具体的な配置が判らないので、
↓の画像の右上Sheet（Sheet2とします）に
列ごとに関連メーカーの表を作成しておきます。

そして、Sheet1のデータをSheet3に表示するようにしてみました。
VBAになってしまいますが、一例です。

Alt＋F11キー　→　メニュー　→　挿入　→　標準モジュール　→　VBE画面（カーソルが点滅しているところ）に
↓のコードをコピー＆ペースト　→　Excel画面に戻りマクロを実行してみてください。
（Alt＋F8キー　→　マクロ　→　マクロ実行です）

Sub Sample1() 'この行から
Dim i As Long, j As Long, lastRow As Long
Dim c As Range, r As Range, myRange As Range
Dim wS1 As Worksheet, wS2 As Worksheet, wS3 As Worksheet
Set wS1 = Worksheets("Sheet1")
Set wS2 = Worksheets("Sheet2")
Set wS3 = Worksheets("Sheet3")
lastRow = wS3.Cells(Rows.Count, "A").End(xlUp).Row
If lastRow > 1 Then
Range(wS3.Cells(2, "A"), wS3.Cells(lastRow, "C")).ClearContents
End If
wS3.Range("A:A").Insert
On Error Resume Next '←念のため
For i = 1 To wS1.Cells(Rows.Count, "A").End(xlUp).Row
Set c = wS2.Cells.Find(what:=wS1.Cells(i, "A"), LookIn:=xlValues, lookat:=xlWhole)
j = c.Column
Set r = wS3.Range("A:A").Find(what:=j, LookIn:=xlValues, lookat:=xlWhole)
If r Is Nothing Then
With wS3.Cells(Rows.Count, "A").End(xlUp).Offset(1)
.Value = j
.Offset(, 1) = wS1.Cells(i, "A")
.Offset(, 2) = wS1.Cells(i, "B")
.Offset(, 3) = wS1.Cells(i, "C")
End With
Else
Set myRange = wS3.Range("A:A").Find(what:=j, LookIn:=xlValues, lookat:=xlWhole)
If InStr(myRange.Offset(, 1), wS1.Cells(i, "A")) = 0 Then
With myRange.Offset(, 1)
.Value = .Value & "," & wS1.Cells(i, "A")
.Offset(, 1) = .Offset(, 1) + wS1.Cells(i, "B")
.Offset(, 2) = .Offset(, 2) + wS1.Cells(i, "C")
End With
Else
With myRange.Offset(, 2)
.Value = .Offset(, 2) + wS1.Cells(i, "B")
.Offset(, 3) = .Offset(, 3) + wS1.Cells(i, "C")
End With
End If
End If
Next i
wS3.Range("A:A").Delete
wS3.Columns.AutoFit
End Sub 'この行まで

※　関数でないので、Sheet1のデータ変更があるたびに
マクロを実行する必要があります。m(_ _)m

回答No.2

Cupper-2

MATCH関数でA列の文字列がシート２の一覧に含まれるか確認して、どこか空いている列にマークをつける。
そのマークを元にB列とC列に対して合計をSUMIF関数で求める。
で良いんじゃない？

あとは好きに文字列にしていじれば良いと思うんです。

一度に解決しようとせず、作業列を設けるだけで解決することが多くあります。
難しく考えず、手作業で処理する手順をそのまま数式で再現してみるなどしてみましょう。

回答No.1

MackyNo1

商品名の条件ごとに集計するのはSUMIF関数でできますので（大文字と小文字は区別しないで良い）、問題は以下のシート2のまとめたいデータの判断ということになります。

＞条件としては、シート２のメーカー名の一覧を元に含まれていれば同じ内容として、カンマ区切りで一行にまとめたいです。

このようなご質問では、実際のデータ数や項目数によって、効率的な数式が異なりますので、データ数やリストのレイアウトなど（商品名のメーカーがA列にありB列から右に商品名などの検索条件が最大3件まで入力されているなど）、もう少し具体的に説明されたほうが良いと思います。

ちなみにカンマで区切ってデータを表示するというのは、一般的にあまり効率的な数式を作成することができませんので、今回のご質問のケースではメーカー名ごとの数式にする、あるいはセルに分けて表示するなどの対応をさせることをお勧めします。