みんなの「教えて(疑問・質問)」にみんなで「答える」Q&Aコミュニティ

こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

Excel カンマ連結

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

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

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


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

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

投稿日時 - 2014-07-23 09:33:02

QNo.8689085

困ってます

質問者が選んだベストアンサー

>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

投稿日時 - 2014-07-25 14:42:13

お礼

ありがとうございます。

投稿日時 - 2014-07-25 15:02:53

ANo.3

このQ&Aは役に立ちましたか?

1人が「このQ&Aが役に立った」と投票しています

回答(3)

ANo.2

こんばんは!
↓の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

投稿日時 - 2014-07-23 23:09:19

お礼

ありがとうございます。

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

投稿日時 - 2014-07-24 09:06:10

ANo.1

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

選択するところは2行目に限定しています。
どの行でもという事であれば
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

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

投稿日時 - 2014-07-23 15:18:49

補足

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

投稿日時 - 2014-07-25 13:35:31

お礼

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

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

投稿日時 - 2014-07-24 09:03:15

あなたにオススメの質問