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

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

解決済みの質問

Excel 連結

表に

東京 神奈川 千葉 埼玉 茨城 栃木 群馬
1     1     1          
     1          1            1
1                   1

とはいって

1行目 東京,神奈川,千葉
2行目 神奈川,埼玉,群馬
3行目 東京,茨城


と1が立っているとこを間にカンマを入れて連結したいです。
Excelの関数かマクロでお願いします。

投稿日時 - 2014-07-16 15:34:53

QNo.8680611

すぐに回答ほしいです

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

続けてお邪魔します。

>1が入っているのは3行目からだそうなので
>対応したのをできますか?

2行目までに「1」というデータがなければNo.4のSample2 のコードでも大丈夫だと思いますが、
どうしてもというコトであれば
Sample2の
>For i = 2 To .UsedRange.Rows.Count

>For i = 3 To .UsedRange.Rows.Count
に変更してみてください。

※ その後の補足で範囲指定した後にマクロを実行させたい!というコトでしたので、
列すべてを範囲指定 → マクロ実行 としたい場合は↓のコードにしてみてください。

Sub Sample4()
Dim i As Long, j As Long, cnt As Long, str As String, wS As Worksheet
Set wS = Worksheets("Sheet2")
wS.Cells.ClearContents
With Worksheets("Sheet1")
For i = 3 To Selection(Selection.Count).Row '←3行目~選択最終行まで
For j = Selection(1).Column To Selection(Selection.Count).Column
If .Cells(i, j) = 1 Then
str = str & .Cells(1, j) & ","
If j > .UsedRange.Columns.Count Then Exit For
End If
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 With
End Sub

※ Sheetすべてを選択し、マクロを実行するとエラーとなります。
列だけをすべて選択(複数列)するのは問題ありません。m(_ _)m

投稿日時 - 2014-07-18 21:24:27

補足

Sample4を実行するとカンマだけ表示されるのですが
どうしてでしょうか?

投稿日時 - 2014-07-22 09:45:39

お礼

毎度毎度ありがとうございます。助かります!

投稿日時 - 2014-07-18 23:14:08

ANo.6

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

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

回答(6)

ANo.5

No.2・4です。

>A~C列を選択してデータを出すというように選択するということはできますか?
>選択列はいろいろです。

必ずSheet1の範囲指定をしたのちにマクロを実行してください。

Sub Sample3()
Dim i As Long, j As Long, cnt As Long, str As String, wS As Worksheet
Set wS = Worksheets("Sheet2")
wS.Cells.ClearContents
With Worksheets("Sheet1")
For i = 2 To .UsedRange.Rows.Count
For j = Selection(1).Column To Selection(Selection.Count).Column
If .Cells(i, j) = 1 Then
str = str & .Cells(1, j) & ","
End If
Next j
If Len(str) > 1 Then
cnt = cnt + 1
wS.Cells(cnt, "A") = Left(str, Len(str) - 1)
End If
str = ""
Next i
End With
End Sub

※ 行に関してはデータが入っている最終行までとしています。
もし、行も範囲指定する場合は上記コード内の
>For i = 2 To .UsedRange.Rows.Count
の行を
>For i = Selection(1).Row To Selection(Selection.Count).Row
に変更してください。
この場合、仮に1行目を範囲指定しても1行目(項目行)は無視されます。
(1行目に「1」は入らないと思いますので・・・)

※ 後者コードで列すべてを範囲指定してしまうと、
データがあるなしにかかわらずSheetの最終行までループしてしまいますので、
「応答なし」になる可能性があります。
色々な場合を想定すればそういったことを回避するコードを入れてもよいのですが、
まずはこの程度で・・・m(_ _)m

投稿日時 - 2014-07-18 17:19:05

補足

1が入っているのは3行目からだそうなので
対応したのをできますか?

本当にすみませんが。

投稿日時 - 2014-07-18 17:37:15

ANo.4

No.2です。
補足の
>A1から表示したいときはどうしたらいいですか?
について、
手抜きになりますが、前回のコードの最後(End Sub)の1行前に
>wS.Rows(1).Delete
を加えるだけでお望み通りになると思います。

※ 丁寧にやれば↓のようなコードでも同様の結果になります。

Sub Sample2()
Dim i As Long, j As Long, cnt As Long, str As String, wS As Worksheet
Set wS = Worksheets("Sheet2")
wS.Cells.ClearContents
With Worksheets("Sheet1")
For i = 2 To .UsedRange.Rows.Count
For j = 1 To .Cells(1, Columns.Count).End(xlToLeft).Column
If .Cells(i, j) = 1 Then
str = str & .Cells(1, j) & ","
End If
Next j
If Len(str) > 1 Then
cnt = cnt + 1
wS.Cells(cnt, "A") = Left(str, Len(str) - 1)
End If
str = ""
Next i
End With
End Sub

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

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

補足

何度も申し訳ないのですが
A列~G列に東京~群馬が入っていてA~C列を選択してデータを出すというように選択するということはできますか?

選択列はいろいろです。

できたらおねがいします。

投稿日時 - 2014-07-18 16:59:37

お礼

ご丁寧にどうもありがとうございます。

投稿日時 - 2014-07-18 16:41:42

ANo.3

Excelの関数かマクロということなので、両方を兼ねたユーザー定義関数を作ってみました。

普通の関数のように使います。

=JoinCell(「1が入力されたセル範囲」,「連結する文字のセル範囲」)  

とします。添付図を見てください。

入力は即時に反映します。2つの引数の列数さえ一致していれば列数は自由に増減できます。


ご参考に。

標準モジュールに貼り付けます。


Function JoinCell(elmRng As Range, Hyoudai As Range)
  Dim c As Integer '行カウンタ
  Dim strJoin As String '連結した文字

  '引数がおかしかったら計算しない
  If elmRng.Count <> Hyoudai.Count Then
    JoinCell = "": Exit Function
  End If

  '文字列の連結
  For c = 1 To elmRng.Count
    If elmRng.Cells(c).Value = 1 Then
      strJoin = strJoin & "," & Hyoudai.Cells(c)
    End If
  Next

  '整形
  JoinCell = Mid(strJoin, 2)
End Function

投稿日時 - 2014-07-16 17:29:10

お礼

ありがとうございます。Join初めて知りました。

投稿日時 - 2014-07-17 09:25:17

ANo.2

こんにちは!
VBAでの一例です。

元データはSheet1にあり、↓の画像のような配置(上側)になっているとします。
1行目が何列あっても対応できるようにしています。
Sheet2のA列の同じ行に表示するようにしてみました。

Alt+F11キー → メニュー → 挿入 → 標準モジュール → VBE画面のカーソルが点滅しているところに
↓のコードをコピー&ペースト → Excel画面に戻りマクロを実行してみてください。
(Alt+F8キー → マクロ → マクロ実行です)

Sub Sample1() 'この行から
Dim i As Long, j As Long, str As String, wS As Worksheet
Set wS = Worksheets("Sheet2")
wS.Cells.ClearContents
With Worksheets("Sheet1")
For i = 2 To .UsedRange.Rows.Count
For j = 1 To .Cells(1, Columns.Count).End(xlToLeft).Column
If .Cells(i, j) = 1 Then
str = str & .Cells(1, j) & ","
End If
Next j
If Len(str) > 1 Then
wS.Cells(i, "A") = Left(str, Len(str) - 1)
End If
str = ""
Next i
End With
End Sub 'この行まで

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

投稿日時 - 2014-07-16 16:24:41

補足

A1から表示したいときはどうしたらいいですか?

投稿日時 - 2014-07-18 14:52:32

お礼

すごい!!!ありがとうございます!

投稿日時 - 2014-07-16 16:38:06

ANo.1

A1:G4の範囲にデータがあるとして、

H2のセルに以下のように入力。下へオートフィル

=SUBSTITUTE(TRIM(IF(A2=1,A$1,"")&" "&IF(B2=1,B$1,"")&" "&IF(C2=1,C$1,"")&" "&IF(D2=1,D$1,"")&" "&IF(E2=1,E$1,"")&" "&IF(F2=1,F$1,"")&" "&IF(G2=1,G$1,""))," ",",")

投稿日時 - 2014-07-16 15:45:45

お礼

どうもありがとうございます!

投稿日時 - 2014-07-16 16:41:49

あなたにオススメの質問