特定の文字がある際に複数行を一つのセルにまとめる方法

いつもお世話になっております。
特定の文字があるときに複数行のセルを1つにまとめるにはどうすれば良いでしょうか？
ちなみにヴァージョンはEXCEL2007を使用しておりますので
どうぞアドバイスよろしくお願い致します。

【やりたいこと】
例えば下記のようなSheet1があるとして
日付毎に品川店で出荷するものがあればSHEET2の
A列＝出荷日、B列＝店舗、C列に品番全てを入力したいです。
難しいようであれば品番だけでも一つのセルにまとめたいのですが可能でしょうか？

SHEET1 元データ　1行目が項目でA2～J200行まで
A列　　 　　　B列　. . .　　　F列
品番 　　　　 店舗　　 　　 出荷日
100-03 　　　 品川　　 　　 5/29
100-02 　　　自由が丘　　　6/1
100-03　　　 横浜　　 　　　6/1
100-04 　　　 品川　　 　　　 5/31
100-05 　　　品川　　 　　　 5/29

SHEET2　チェックリスト　1行目が項目
A列　　　　　 B列 　　　C列
出荷日 　　　店舗 　　品番
5/29 　　　　品川 　　 100-03*100-05
5/31 　　　　品川 　　 100-04

Sub Sample1()
Dim i As Long
Dim j As Long
Dim k As Long
Dim n As Long
Dim LstR As Long

'出荷日
n = 2
LstR = Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Sheet1").Select
For i = 2 To LstR
If Cells(i, 2) = "品川" Then
Cells(i, 2).Offset(, 4).Resize(, 1).Copy _
Sheets("Sheet2").Cells(n, 1)
n = n + 1
End If
Next i
'店舗
For j = 2 To LstR
If Cells(j, 2) = "品川" Then ←B列の2行目から張りたい
Cells(j, 2).Copy
Sheets("Sheet2").Cells(n, 2)
n = n + 1
End If
Next j
'品番をまとめる
End Sub

↓をやると一つのセルにまとめられるのですが
"品川"と条件を付けるのにどうしたらよいかわかりません。。。
どうぞお助け願い致します。


Dim i As Long
For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
Range("B1").value = Range("B1").value & Range("A" & i)
Next i

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

• 

  もちろんです！むしろその方がありがたいです！
  品番を連結する際に使うのはアフタリスクでもなんでも大丈夫です。
  よろしくお願いします。

  No.1の回答に寄せられた補足コメントです。 補足日時：2018/05/25 15:13

No.3 回答者： tom04 回答日時： 2018/05/25 17:06

こんにちは！

すでに回答は出ていますので、参考程度で・・・
標準モジュールです。

Sub Sample1()
Dim myDic As Object
Dim i As Long, lastRow As Long
Dim myStr As String, wS As Worksheet
Dim myKey, myItem, myAry
Set myDic = CreateObject("Scripting.Dictionary")
Set wS = Worksheets("Sheet2")
lastRow = wS.Cells(Rows.Count, "A").End(xlUp).Row
If lastRow > 1 Then
Range(wS.Cells(2, "A"), wS.Cells(lastRow, "C")).ClearContents
End If
With Worksheets("Sheet1")
wS.Range("A:A").NumberFormatLocal = .Range("C2").NumberFormatLocal
For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
If .Cells(i, "B") = "品川" Then '//★//
myStr = .Cells(i, "B") & "_" & .Cells(i, "C")
If Not myDic.exists(myStr) Then
myDic.Add myStr, .Cells(i, "A")
Else
myDic(myStr) = myDic(myStr) & "*" & .Cells(i, "A")
End If
End If
Next i
End With
myKey = myDic.keys
myItem = myDic.items
For i = 0 To UBound(myKey)
myAry = Split(myKey(i), "_")
wS.Cells(i + 2, "A") = myAry(1)
wS.Cells(i + 2, "B") = myAry(0)
wS.Cells(i + 2, "C") = myItem(i)
Next i
Set myDic = Nothing
wS.Columns.AutoFit
MsgBox "完了"
End Sub

※　今回は「品川」限定のコードなので、店舗を変更したい場合は「★」の行を変えてください。
No.２様のようにどこかのセルに「店舗名」を入力しておき
それを参照する方が汎用性があると思います。m(_ _)m

この回答へのお礼

いつもありがとうごさいます！
大変勉強になり、とても感謝です！

お礼日時：2018/05/25 17:35

No.2 ベストアンサー 回答者： tatsu99 回答日時： 2018/05/25 15:19

No1です。

以下のマクロを標準モジュールに登録してください。
実行時にはF1へ店舗名を指定してください。
---------------------------------------------
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 wrow2 As Long
Dim dicT As Object
Dim key As Variant
Dim tempo As String
Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義
Set sh1 = Worksheets("sheet1")
Set sh2 = Worksheets("sheet2")
maxrow1 = sh1.Cells(Rows.Count, 1).End(xlUp).Row 'sheet1 最終行を求める
tempo = sh2.Cells(1, "F").Value
If tempo = "" Then
MsgBox ("集計店舗が設定されていません")
Exit Sub
End If
'sheet2の2行目以降をクリア
sh2.Rows("2:" & Rows.Count).ClearContents 'Sheet2の2行目以降をクリア
row2 = 2
'sheet1の最終行まで繰り返す
For row1 = 2 To maxrow1
'集計対象店舗のみ行う
If sh1.Cells(row1, "B").Value = tempo Then
key = sh1.Cells(row1, "C").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 = tempo
sh2.Cells(row2, "C").Value = sh1.Cells(row1, "A").Value
row2 = row2 + 1
Else
'出荷日が既存の場合、品番を該当行に追加する
wrow2 = dicT(key)
sh2.Cells(wrow2, "C").Value = sh2.Cells(wrow2, "C").Value & "*" & sh1.Cells(row1, "A").Value
End If
End If
Next
MsgBox ("処理完了")
End Sub

この回答へのお礼

最初試したときはあまりの希望通りに感動しました！
本当に助かったので感謝です！！
二人ともベストアンサーにしたいのですが
tatsu99さんはすぐに対応してくれたので感謝を込めてベストアンサーにしたいと思います。

お礼日時：2018/05/25 17:38

No.1 回答者： tatsu99 回答日時： 2018/05/25 14:59

マクロの一からの作り直しになりますが、

添付図のようにSheet2のF1のセルに集計対象の店舗名（この例では品川）を記入し、
その指定された店舗名について、集計するようにしてはいかがでしょうか。（添付図の黄色のセル）
そうすれば、他の店舗の集計をするときに、その都度、マクロを変更しなくて済みます。
それで良ければ、マクロの提供は可能です。

また、その場合、品番を連結する時にアスタリスク"*"を使用していますが、それで良いですか。（添付図の赤線で囲んだところ）