Excelのデータ表示変更（横：１セル⇒縦：複数セル）

質問

Excelで同一セル内にに記載してあるデータ（カンマ区切り）を
行を分けて表示したいのですが、簡単な方法はありますか？

例）

A列 B列
---- --------
001 T1,T2,T3

を

A列 B列
---- --------
001 T1
001 T2
001 T3

と変更したいのです。

アドバイスをお願いいたします。

回答No.6

Wendy02

こんばんは。

こんな風にしたらどうでしょうか？
ただし、C列, D列を使用して展開して、それを元の列に戻して上書きしています。
上書きモードを避けたいのでしたら、

　Const MYOPTION As Boolean = False

にすると、C列、D列に展開されます。

このような展開方法に問題があれば、全面的に書き換えます。
なお、Version は、XL2000 ～　2003　で稼動します。

'------------------------------------------

Sub TestSplit()
　Dim myRng As Range
　Dim buf As String
　Dim myAry As Variant
　Dim i As Long, j As Long
　Dim strFirst As String
　'上書きモード　False =OFF, True = ON
　Const MYOPTION As Boolean = True

　If Selection.Count = 1 Then
　　Set myRng = ActiveCell.CurrentRegion
　Else
　　Exit Sub
　End If

　With myRng
　　If WorksheetFunction.CountA(.Cells) < 2 Then
　　　MsgBox "分割するセルを選択をしてください。", vbInformation
　　　Exit Sub
　　End If
　　If .Columns.Count <> 2 Then
　　　MsgBox "データは2列でないと、現在のマクロでは出来ません。", vbInformation
　　　Exit Sub
　　End If
　　If InStr(.Cells(1, 2).Value, ",") = 0 Then
　　　MsgBox "カンマ付きデータではありません。", vbInformation
　　　Exit Sub
　　End If
　End With
　i = 0 '行の初期設定
　Application.ScreenUpdating = False
　For Each c In myRng.Columns(2).Cells
　　myAry = Split(c.Value, ",")
　　c.Offset(i, 1).Resize(UBound(myAry) + 1).NumberFormatLocal = "000"
　　c.Offset(i, 1).Resize(UBound(myAry) + 1).Value = c.Offset(, -1).Value
　　For j = 0 To UBound(myAry)
　　　c.Offset(j + i, 2) = Trim(myAry(j))
　　Next j
　　i = i + UBound(myAry)
　Next c
　If MYOPTION Then
　　 With myRng.CurrentRegion.Offset(, 2).Resize(, 2)
　　　　.Copy myRng.Cells(1, 1)
　　　　.Clear
　　 End With
　End If
　Application.ScreenUpdating = True
　Set myRng = Nothing
End Sub

'------------------------------------------

お礼

返事が遅くなり大変申し訳ございませんでした。

どうもありがとうございます！
望んだ結果が返ってまいりました。

この方法にて対応を行いたいと思います。

回答No.5

134

^^;)

説明不足ということはなかったように思います。

１行に展開されたデータを…

6.　形式を選択して貼り付け→値　、　行列を入れ替える　とし、ＯＫ　とする。
7.　Ａ列の「００１」に相当する値を、必要量コピーする

としたつもりです。

データが多いと、煩雑になりやすいので、ほかの方の回答のようなマクロの方が、簡便なのでしょうけどね。

お礼

お返事が遅くなり申し訳ございません。

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

134様がおっしゃるっとおりデータ量が多めなので
マクロにて実施したいと思います。

どうもありがとうございました。

回答No.4

Wendy02

#2です。

>同一セル内にに記載してある

と書いてありましたので、質問の読み違えました。

セルが分かれているので、関数の処理も考えました。

A1　　　B1
001　　 T1,T2,T3

A2:
=IF(B2<>"",$A$1,"")

B2:
=MID($B$1,1,FIND(",",B1)-1)

B3:
一応のエラー処理は施してあります。
フィルダウン・コピー

=IF(ISERROR(FIND("^",SUBSTITUTE($B$1,",","^",ROW(A1)))),"",IF(ISERROR(FIND("^",SUBSTITUTE($B$1,",","^",ROW(A2)))),RIGHT($B$1,LEN($B$1)-FIND("^",SUBSTITUTE($B$1,",","^",ROW(A1)))),MID($B$1,FIND("^",SUBSTITUTE($B$1,",","^",ROW(A1)))+1,FIND("^",SUBSTITUTE($B$1,",","^",ROW(A2)))-FIND("^",SUBSTITUTE($B$1,",","^",ROW(A1)))-1)))

となります。

なお、マクロの修正をしておきます。

一応、どこのモジュール（クラスModule以外)に貼り付けても可能なはずです。
'--------------------------------------------------------
Sub TestSplitR()
　Dim myRng As Range
　Dim buf As String
　Dim myAry As Variant
　Dim strFirst As String
　If Selection.Count > 0 Then
　　Set myRng = Selection.Cells(1, 1)
　End If

　With myRng
　　If .Value = "" Or InStr(.Offset(, 1).Value, ",") = 0 Then
　　　MsgBox "横に2列並んでいるセルを選択をしてください。", vbInformation
　　　Exit Sub
　　End If
　　myAry = Split(.Offset(, 1).Value, ",")

　　Application.ScreenUpdating = False
　　.Offset(1).Resize(UBound(myAry) + 1).NumberFormatLocal = "000"
　　.Offset(1).Resize(UBound(myAry) + 1).Value = .Value
　　For i = 0 To UBound(myAry)
　　　.Cells(i + 2, 2) = Trim(myAry(i))
　　Next i
　　Application.ScreenUpdating = True
　End With
　Set myRng = Nothing
End Sub
'--------------------------------------------------------

補足

いろいろと考えていただき
ありがとうございます。

関数、マクロと両方試したのですが、
いずれも単一行の場合のみの変換ですよね。

こちらの説明不足で申し訳ないのですが
複数行の対応方法についても教えていただけますと
大変助かります。

回答No.3

NCU

'単一セルを選択して実行
Sub カンマ区切りの文字列を縦に展開()
　　Dim myStr As String, myArr As Variant
　　With Selection
　　　　If .Count > 1 Then Exit Sub
　　　　myStr = .Text
　　　　If myStr = "" Then Exit Sub
　　　　myArr = Split(Replace(myStr, ", ", ","), ",")
　　　　.Resize(UBound(myArr) + 1).Value = WorksheetFunction.Transpose(myArr)
　　End With
End Sub

補足

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

すいません。
こちらの説明不足でした。

以下のように、複数行の場合は無理でしょうか？

A B
--- ------
001 T1,T2,T3
002 T4,T5,T6

↓

A B
--- ------
001 T1
001 T2
001 T3
002 T4
002 T5
002 T6

回答No.2

Wendy02

こんばんは。

関数でも考えて見ましたが、補助セルを使わないとややこしくなりそうなので、マクロで考えてみました。その文字列の下に展開されます。その文字をアクティブにしてから、実施してみてください。

Sub TestSplit()
　Dim buf As String
　Dim myAry As Variant
　Dim strFirst As String
　With ActiveCell
　If .Value = "" Or InStr(.Value, " ") = 0 Then Exit Sub
　strFirst = Mid(.Value, 1, InStr(.Value, " ") - 1)
　buf = Mid(.Value, InStr(.Value, " ") + 1)
　myAry = Split(buf, ",")

　Application.ScreenUpdating = False
　For i = 0 To UBound(myAry)
　　.Cells(i + 2, 1).NumberFormatLocal = "000"
　　.Cells(i + 2, 1).Value = strFirst
　　.Cells(i + 2, 2) = Trim(myAry(i))
　Next i
　Application.ScreenUpdating = True
　End With
End Sub

補足

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

すいません。
こちらの説明不足でした。

以下のように、複数行の場合は無理でしょうか？

A B
--- ------
001 T1,T2,T3
002 T4,T5,T6

↓

A B
--- ------
001 T1
001 T2
001 T3
002 T4
002 T5
002 T6

回答No.1

134

1.　Ｂ２セルをクリック
2.　データ→区切り位置
3.　区切り記号に「カンマ」をチェック
4.　ウィザードに従い、最後まで
5.　複数行に、データが分割されるので、分割されたデータをコピー
6.　形式を選択して貼り付け→値　、　行列を入れ替える　とし、ＯＫ　とする。
7.　Ａ列の「００１」に相当する値を、必要量コピーする

　という方法が、最も早そうですかね。

補足

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

すいません。
こちらの説明不足でした。

以下のように、複数行の場合は無理でしょうか？

A B
--- ------
001 T1,T2,T3
002 T4,T5,T6

↓

A B
--- ------
001 T1
001 T2
001 T3
002 T4
002 T5
002 T6