【VBA】条件に一致したセル値をカンマ区切りで結合したい

VBA初心者です。

添付の画像の商品リストがあり、C1からG1に出荷コードがあります。
商品データには出荷コード毎に”○”が記載されており、”○”の場合、対応する出荷コードを結合し、
他セルに表示させたいです。複数”○”がある場合、カンマで区切り出荷コードを結合したいです。

例：　りんごパイの場合、C列とD列に”○”が入力されているため、
　　　w001,s332　と結合して他セルに表示させたい。

よろしくお願い致します。

No.1 ベストアンサー 回答者： tom04 回答日時： 2016/08/22 21:27

こんばんは！

＞・・・結合して他セルに表示させたい。
とありますが、どこのセルに表示すれば良いのか判らないので
元データはSheet1にあり、Sheet2に表示するようにしてみました。
（質問ではG列までしかないようですが、もっと列数が増えても対応できるようにするため）
標準モジュールにしてください。

Sub Sample1()
Dim i As Long, j As Long, cnt As Long
Dim myStr As String, wS As Worksheet
Set wS = Worksheets("Sheet2")
wS.Cells.Clear
With Worksheets("Sheet1")
For i = 3 To .Cells(Rows.Count, "A").End(xlUp).Row
For j = 3 To .Cells(1, Columns.Count).End(xlToLeft).Column
If .Cells(i, j) = "○" Then
myStr = myStr & .Cells(1, j) & ","
End If
Next j
If Len(myStr) > 0 Then
cnt = cnt + 1
wS.Cells(cnt, "A") = .Cells(i, "A")
wS.Cells(cnt, "B") = Left(myStr, Len(myStr) - 1)
End If
myStr = ""
Next i
wS.Columns.AutoFit
End With
End Sub

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

この回答へのお礼

お礼が遅くなり申し訳ありません。
回答いただいた方法でうまくいきました！
ありがとうございます！

お礼日時：2016/08/30 23:27

No.3 回答者： ママチャリ 回答日時： 2016/08/23 21:31

ユーザ定義関数での実装はいかがでしょう。

下記のユーザ定義関数(userCONCATENATE)を標準モジュールに張り付けた後、シート上に次の式を入力して、下にコピーしてください。

H3セル =userCONCATENATE($C$1:$G$1,C3:G3)

Function userCONCATENATE(出荷コード範囲 As Range, 丸印範囲 As Range) As Variant
Dim i As Long
userCONCATENATE = ""
For i = 1 To 丸印範囲.Count
If 丸印範囲(i).Value = "○" Then
If userCONCATENATE <> "" Then userCONCATENATE = userCONCATENATE & ","
userCONCATENATE = userCONCATENATE & 出荷コード範囲(i).Value
End If
Next
End Function

この回答へのお礼

お礼が遅くなり申し訳ありません。
ユーザ定義関数の実装、勉強になりました！
userCONCATENATE関数の貼りつけ先セルが
Excelマクロをあまり知らない方に消されないか心配でしたので、また別の機会にユーザ定義関数を実装しようかと思います。ありがとうございます！

お礼日時：2016/08/30 23:33

No.2 回答者： WindFaller 回答日時： 2016/08/23 01:07

私には、ご質問の意味がよく分からない部分があります。

>w001,s332　と結合して他セルに表示させたい。
結合って、セルとセルをくっつけるExcel独特の用語だったと思います。
文字列と文字列をカンマでつなぐことは、単に文字列を合わせただけのように思います。セルとセルは結合しても、文字列は、左側のものしか残りません。それ以外に何か特別な意味があるのでしょうか。

なお、◯がひとつもないものは出力しません。
また、◯には同じしか見えない別の種類のものがありますから、二種類はヒットするようにしました。

出力の場所は、ご自身でお決めください。

'//
Sub OutputLists()
　Dim DeliCode　As Variant
　Dim i As Long, j As Long, k As Long
　Dim outList As String
　Dim buf As String
　Dim Arbuf() As Variant
　With ActiveSheet
　DeliCode = .Range("C1:G1").Value
　DeliCode = Application.Index(DeliCode, 1, 0)
　For i = 3 To .Cells(Rows.Count, 1).End(xlUp).Row
　　For j = 1 To 5
　　　'同じ丸でも、種類があります。
　　　If .Cells(i, 2 + j).Value Like "[○◯]*" Then
　　　　If Len(buf) = 0 Then
　　　　　buf = DeliCode(j)
　　　　Else
　　　　　buf = buf & ", " & DeliCode(j)
　　　　End If
　　　End If
　　Next j
　　If buf <> "" Then
　　　ReDim Preserve Arbuf(1, k)
　　　Arbuf(0, k) = .Cells(i, 1).Value
　　　Arbuf(1, k) = buf
　　　k = k + 1
　　End If
　　buf = ""
　Next i
　End With
　With Worksheets("Sheet2") '出力
　　.Range("A1:B1").Value = Array("商品名", "出荷コード")
　　With .Range("A2") 'A2から
　　For i = 0 To k - 1
　　　.Offset(i, 0).Value = Arbuf(0, i)
　　　.Offset(i, 1).Value = Arbuf(1, i)
　　Next i
　 End With
　End With
End Sub
'//