【エクセル】データの抽出方法

質問

元データ（手入力）を、重複している項目を一つにまとめ、かつ、隣のセルの内容は消さずにまとめたいと考えています。
まとめた際に、重複した件数も数字として算出したいと思います。（可能であれば）

出来れば、関数で済ませたいと思いますが、他の方法でも構いませんので
教えて頂ければと思います。

＜元データ＞
製品　　　取り扱い店
エアコン　東京店
ストーブ　さいたま店
パソコン　栃木店
エアコン　さいたま店
カメラ　　横浜店
パソコン　東京店

＜抽出データ＞
取扱店舗数　　製品　　　取り扱い店
２　　　　　　　　エアコン　東京店,さいたま店
１　　　　　　　　ストーブ　さいたま店
２　　　　　　　　パソコン　栃木店,東京店
１　　　　　　　　カメラ　　横浜店
（まとめたデータは、一つのセル内にカンマ（カンマ以外でも可）で区切るorセルで区分ける）

回答No.4

kagakusuki · ベストアンサー

元データに、新たに製品名や取扱店が追加されたり、行の切り取り、貼付け、削除、挿入等の編集作業が行われても、自動的に対応可能な方法です。

　今仮に、元データの表中で、「製品」と入力されているのがSheet1のA1セルで、抽出データの表中で、「取扱店舗数」と入力されているのがSheet2のA1セルであるものとします。
　又、Sheet3のA列とB列を作業列として使用するものとします。
　まず、Sheet3のA1セルに次の数式を入力して下さい。

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

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

=IF(INDEX(Sheet1!$A:$A,ROW())="","",INDEX(Sheet1!$A:$A,ROW())&"゛"&COUNTIF(Sheet1!$A$1:INDEX(Sheet1!$A:$A,ROW()),INDEX(Sheet1!$A:$A,ROW())))

　次に、Sheet3のA1～B1の範囲をコピーして、同じ列の2行目以下に貼り付けて下さい。
　次に、Sheet2のA2セルに次の数式を入力して下さい。

=IF($B2="","",COUNTIF(Sheet1!$A:$A,$B2))

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

=IF(ROWS($1:2)>COUNT(Sheet3!$A:$A),"",INDEX(Sheet1!$A:$A,SMALL(Sheet3!$A:$A,ROWS($1:2))))

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

=IF(OR($A2="",COLUMNS($C:C)>$A2),"",INDEX(Sheet1!$B:$B,MATCH($B2&"゛"&COLUMNS($C:C),Sheet3!$B:$B,0)))

　次に、Sheet2のC2セルをコピーして、Sheet2のC2よりも右にあるセル（D2、E2、F2、G2・・・・・）に貼り付けて下さい。
　次に、Sheet2の2行目全体をコピーして、Sheet2の3行目以下に貼り付けて下さい。

　これで、抽出データの表が自動的に作成されます。

お礼

回答者様ご一緒のお礼にて失礼します。
詳しく内容をまとめて頂き、ありがとうございます。
直に、確認できる状況に無い為、お先にお礼とさせて頂きます。

内容確認次第、再度ご質問やベストアンサーを選ばせて頂きます。

回答No.5

tom04

こんにちは！
すでに回答は出ていますので、参考程度で・・・
ご希望の関数ではなく、VBAでの方法になってしまいます。
Sheet1のA・B列にデータがありSheet2に表示するようにしています。

画面左下にあるSheet1のSheet見出し上で右クリック　→　コードの表示　→　VBE画面が出ますので
↓のコードをコピー＆ペーストしてマクロを実行してみてください。
（Alt+F8キー　→　マクロ　→　マクロ実行です）

Sub test() 'この行から
Dim i, j, vl As Long
Dim str As String
Dim ws1, ws2 As Worksheet
Set ws1 = Worksheets("sheet1")
Set ws2 = Worksheets("sheet2")
ws2.Cells.Clear
With ws2.Cells(1, 1)
.Value = "取扱店舗数"
.Offset(, 1) = "製品"
.Offset(, 2) = "取り扱い店"
End With
For i = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row
If WorksheetFunction.CountIf(ws2.Columns(2), ws1.Cells(i, 1)) = 0 Then
ws2.Cells(Rows.Count, 2).End(xlUp).Offset(1) = ws1.Cells(i, 1)
End If
Next i
For j = 2 To ws2.Cells(Rows.Count, 2).End(xlUp).Row
For i = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row
If ws1.Cells(i, 1) = ws2.Cells(j, 2) Then
str = str & ws1.Cells(i, 2) & ","
vl = vl + 1
End If
Next i
With ws2.Cells(j, 1)
.Value = vl
.Offset(, 2) = Left(str, Len(str) - 1)
End With
vl = 0
str = ""
Next j
ws2.Columns("A:C").AutoFit
End Sub 'この行まで

こんな感じではどうでしょうか？m(_ _)m

回答No.3

mu2011

>出来れば、関数で済ませたいと思いますが、他の方法でも構いません
　⇒関数で出来ない事はないと思いますが、マクロの方が一括で抽出できるので以下のＶＢＡコードをお試し下さい。　尚、取扱店はカンマ区切りとしています。

　（１）データをSheet1としてSheet2に抽出します。
　（２）Sheet2タブ上で右クリック→コードの表示→以下のコードを貼り付け→Ｆ５キーを押下

■サンプルコード
Sub Sample1()
見出 = Array("取扱店舗数", "製品", "取扱店")
Set st1 = Worksheets("sheet1")
Set Dic = CreateObject("Scripting.Dictionary")
For i = 2 To st1.Cells(Rows.Count, 1).End(xlUp).Row
buf1 = st1.Cells(i, 1).Value
buf2 = st1.Cells(i, 2).Value
If Not Dic.Exists(buf1) Then
Dic.Add buf1, buf2
Else
Dic.Item(buf1) = Dic.Item(buf1) & "，" & buf2
End If
Next i
For i = 0 To UBound(見出)
Cells(1, 1).Offset(0, i) = 見出(i)
Next
製品 = Dic.keys
店舗 = Dic.Items
For i = 0 To Dic.Count - 1
wk = Split(店舗(i), "，")
Cells(i + 2, 1) = UBound(wk) + 1
Cells(i + 2, 2).Value = 製品(i)
Cells(i + 2, 3).Value = 店舗(i)
Next
Columns("a:c").AutoFit
Set Dic = Nothing
End Sub

回答No.2

imogasi

表の組み換え問題なのでＶＢＡで無いと関数式では複雑になる。
（１）データを製品列でソートしておく（ＶＢＡでも可能だが略）
（２）下記を実行
例データ　ソート後
Ｓｈｅｅｔ１
製品 取り扱い店
エアコン 東京店
エアコン さいたま店
カメラ 横浜店
ストーブ さいたま店
パソコン 栃木店
パソコン 東京店
ーー
コード　標準モジュールに
Sub test01()
Dim sh1, sh2
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
d = sh1.Range("A65536").End(xlUp).Row
k = 2
l = 0
m = sh1.Cells(2, "A")
a = sh1.Cells(2, "B")
l = 1
For i = 3 To d
If sh1.Cells(i, "A") = m Then
a = a & "," & sh1.Cells(i, "B")
l = l + 1
Else
sh2.Cells(k, "A") = l
sh2.Cells(k, "B") = m
sh2.Cells(k, "C") = a
k = k + 1
m = sh1.Cells(i, "A")
a = sh1.Cells(i, "B")
l = 1
End If
Next i
sh2.Cells(k, "A") = l
sh2.Cells(k, "B") = m
sh2.Cells(k, "C") = a
End Sub
結果
Ｓｈｅｅｔ２に
2 エアコン 東京店,さいたま店
1 カメラ 横浜店
1 ストーブ さいたま店
2 パソコン 栃木店,東京店

回答No.1

KURUMITO

製品名や取扱店が新たに追加されても自動的に対応できる方法です。
元のデータがシート１のA１セルには製品、B１セルには取扱店とあり各データは下行に入力されているとします。
C列を作業列としてC２セルには次の式を入力して下方にオートフィルドラッグします。

=IF(A2="","",IF(COUNTIF(A$2:A2,A2)=1,INT(MAX(C$1:C1))+1.00001,INT(INDEX(C$1:C1,MATCH(A2,A:A,0)))+COUNTIF(A$2:A2,A2)/100000))

そこでお求めの表ですが例えば別のシートに表示させるとしてA１セルには取扱店舗数、B１セルには製品、C１セルには取扱店として、１か所以上の取扱店については同じ行で横の列に表示させることにします。
A２セルには次の式を入力して下方にオートフィルドラッグします。

=IF(B2="","",COUNTIF(Sheet1!$A:$A,B2))

B２セルには次の式を入力して横方向にオートフィルドラッグしたのちに下方にもオートフィルドラッグします。

=IF(COUNTIF(Sheet1!$C:$C,ROW(A1)+0.00001)=0,"",IF(COLUMN(A1)=1,INDEX(Sheet1!$A:$A,MATCH(ROW(A1)+0.00001,Sheet1!$C:$C,0)),IF(COLUMN(A1)>1,IF(COUNTIF(Sheet1!$C:$C,ROW(A1)+(COLUMN(A1)-1)*0.00001)=0,"",INDEX(Sheet1!$B:$B,MATCH(ROW(A1)+(COLUMN(A1)-1)*0.00001,Sheet1!$C:$C,0))),"")))