Excel カンマ連結

質問

渋谷　 鎌倉　 浦安　大宮　日立　日光　高崎
東京　神奈川　千葉　埼玉　茨城　栃木　群馬
1 　　　　1 　　　　1 　　　　　　 　　
　　　　　1 　　　　　　　　 1 　　　　　　　　　 　1
1 　　　　　　　　　　　　　　　　　 1

とはいって東京神奈川千葉のセルを選択したら

1行目　東京,神奈川,千葉
2行目　神奈川
3行目　東京

と1が立っているとこを間にカンマを入れて連結したいです。

行列は可変で、選択するところもいろいろです。
Excelのマクロでお願いします。
面倒でなければ解説を頂きたいです。

回答No.3

mar00 · ベストアンサー

>1がたっていない行のところは詰めずに空白表示したいのですが

もともと何も入力されていないので全角のスペースが入るようにしています。
選択範囲の最後が空白の場合、カンマを入れないと空白かどうかがわからないので最後のカンマを残すようにしています。

Sub Macro2()
Dim Ws01 As Worksheet
Dim Counter As Long, i As Long, j As Long
Dim INP As String

Set Ws = Worksheets("Sheet2")

Ws.Cells.ClearContents
If Selection(Selection.Count).Row <> 2 Then Exit Sub
Counter = 0
For i = 3 To ActiveSheet.UsedRange.Rows.Count
INP = ""
For j = Selection(1).Column To Selection(Selection.Count).Column
If Cells(i, j) = 1 Then
INP = INP & Cells(2, j) & ","
Else
INP = INP & "　" & ","
End If
Next j

If INP <> "" Then
Counter = Counter + 1
If Right(INP, 2) = "　," Then
Ws.Cells(Counter, "A") = INP
Else
Ws.Cells(Counter, "A") = Left(INP, Len(INP) - 1)
End If
End If
Next i
End Sub

お礼

ありがとうございます。

回答No.2

tom04

こんばんは！
↓のURLの続きですね。

http://okwave.jp/qa/q8680611.html

補足を読むのが遅くなってどうもごめんなさい。
こちらに投稿します。
↓の画像のように左側がSheet1で右側のSheet2のA列に表示するようにしています。
画像ではSheet1のA～C列を選択した状態でマクロを実行しています。

今回はSheet1のシートモジュールですので、
画面左下のSheet1のSheet見出し上で右クリック　→　コードの表示　→　VBE画面に
↓のコードをコピー＆ペースト　→　Sheet1で範囲選択した後にマクロを実行してみてください。

Sub Sample5()
Dim i As Long, j As Long, startRow As Long, cnt As Long, str As String, wS As Worksheet
Set wS = Worksheets("Sheet2")
wS.Range("A:A").ClearContents
If Selection(1).Row < 3 Then
startRow = 3
Else
startRow = Selection(1).Row
End If
For i = startRow To Selection(Selection.Count).Row
For j = Selection(1).Column To Selection(Selection.Count).Column
If Cells(i, j) = 1 Then
str = str & Cells(2, j) & ","
End If
If j > UsedRange.Columns.Count Then Exit For
Next j
If Len(str) > 1 Then
cnt = cnt + 1
wS.Cells(cnt, "A") = Left(str, Len(str) - 1)
End If
str = ""
If i > UsedRange.Rows.Count Then Exit For
Next i
End Sub

※　Sheet1の1行目はどんな意味があるのか判らないのですが、
とりあえずSheet1の2行目データを表示するようにしています。m(_ _)m

お礼

ありがとうございます。

すみません。新しく質問してしまって。

回答No.1

mar00

:結果はSheet2の１行目から書き出されます。
シート名が違えば
Set Ws = Worksheets("Sheet2")のSheet2を適宜変更して下さい。

選択するところは２行目に限定しています。
どの行でもという事であれば
If Selection(Selection.Count).Row <> 2 Then Exit Subを削除して下さい。

Sub Macro1()
Dim Ws01 As Worksheet
Dim Counter As Long, i As Long, j As Long
Dim INP As String

Set Ws = Worksheets("Sheet2")

Ws.Cells.ClearContents
If Selection(Selection.Count).Row <> 2 Then Exit Sub
Counter = 0
For i = 3 To ActiveSheet.UsedRange.Rows.Count
INP = ""
For j = Selection(1).Column To Selection(Selection.Count).Column
If Cells(i, j) = 1 Then
INP = INP & Cells(2, j) & ","
End If
Next j

If INP <> "" Then
Counter = Counter + 1
Ws.Cells(Counter, "A") = Left(INP, Len(INP) - 1)
End If
Next i
End Sub

前にも似た質問をされているようですが、やりたいことが変わって質問し直すのであれば
以前の質問は一旦締めてから質問するべきだと思います。

お礼

すみません。以後気を付けます。

ご回答ありがとうございます。

補足

1がたっていない行のところは詰めずに空白表示したいのですが
どうしたらいいでしょうか？