Excelで同一セル内に入力されているデータを他のセルに分割したい

質問

こんにちは。
宜しくお願い致します。

エクセルで同一セル内に、セル内改行で１～６列ほどのデータが入力されています。
A1セル～A100セル…という風に、縦にデータが入力されていて、それぞれのセルにセル内改行を含み、データが入力されているイメージです。

それぞれのセル内のデータを…
例えば、A1セル内に５行入力されていたら、A2セルから入力されている行数分（ここでいうと5行）挿入し、それぞれにデータを分割して入力させたいと思っています。
以下のセルも同様に、挿入→分割といった感じで全データを分割させたいのです。

OKWave内でもチェックして、
http://okwave.jp/qa1927817.html?ans_count_asc=2
や
http://okwave.jp/qa4216384.html
など、近いものはいくつか見つけたのですが、ピッタリのものが見つからず、マクロの編集もよくわからなかったのでこちらで質問させてもらいました。

どなたか申し訳ありませんが、教えていただけますか？
宜しくお願い致します。

回答No.8

zap35 · ベストアンサー

＃０４です。B列、C列の値をコピーするようにしました

Sub Macro1()
Dim idx, cnt As Integer
Dim wkStr() As String
Dim rng As Range
　　ActiveSheet.Copy after:=ActiveSheet
　　For idx = Range("A65536").End(xlUp).Row To 1 Step -1
　　　　If InStr(Cells(idx, "A"), Chr(10)) > 0 Then
　　　　　　wkStr = Split(Cells(idx, "A").Value, Chr(10))
　　　　　　Set rng = Cells(idx, "B")
　　　　　　For cnt = UBound(wkStr) To 0 Step -1
　　　　　　　　Cells(idx, "A").Value = wkStr(cnt)
　　　　　　　　Cells(idx, "B").Value = rng.Value
　　　　　　　　Cells(idx, "C").Value = rng.Offset(0, 1).Value
　　　　　　　　If cnt > 0 Then
　　　　　　　　　　Cells(idx, "A").Resize(1, 3).Insert shift:=xlDown
　　　　　　　　End If
　　　　　　Next cnt
　　　　End If
　　Next idx
End Sub

＞何度も何度も申し訳ありませんが
でもね、こんな風に追加で質問を小出しにされるのはいやですね。
これ以上変更があるならご別スレにしてください。それなら回答します

お礼

＞zap35さま

本当にありがとうございました。

また質問がある際はおっしゃるとおり別スレにいたします。

心から感謝いたします！

回答No.7

zap35

＃０４です。Ｂ列も行を空けるようにしました。
＞A列全部が対象になってたりするとありがたいのですが
そうなっています。Ａ列の最終行まで処理します

Sub Macro1()
Dim idx, cnt As Integer
Dim wkStr() As String
　　ActiveSheet.Copy after:=ActiveSheet
　　For idx = Range("A65536").End(xlUp).Row To 1 Step -1
　　　　If InStr(Cells(idx, "A"), Chr(10)) > 0 Then
　　　　　　wkStr = Split(Cells(idx, "A").Value, Chr(10))
　　　　　　For cnt = UBound(wkStr) To 0 Step -1
　　　　　　　　Cells(idx, "A").Value = wkStr(cnt)
　　　　　　　　If cnt > 0 Then
　　　　　　　　　　Cells(idx, "A").Insert shift:=xlDown
　　　　　　　　End If
　　　　　　Next cnt
　　　　　　Cells(idx + 1, "B").Resize(UBound(wkStr), 1).Insert shift:=xlDown
　　　　End If
　　Next idx
End Sub

お礼

ありがとうございます！！
ちなみにC以降からも増やすとすると、どこをどういじればいいんでしょうか？

参考までにC行も増えるようにしてもらえるとありがたいです。

何度も何度も申し訳ありませんが、宜しくお願い致します。

補足

お礼に書いたものプラス、B列に入っているデータを、A列が増えた分、セルを増やした際、増やしたセルにコピーすることもできますか？

たとえばA１のセルが３つ増えたら、B1のセルに入っていた１という数字を増えた分（B1～B3）にコピーする、とか…。

バラバラ追加で要望が出てしまい、すいません。
宜しくお願い致します。

回答No.6

maron--5

◆関数のよる方法です
◆A1のデータが、B1から右に表示されます
B1=TRIM(INDEX(MID(SUBSTITUTE($A1,CHAR(10),REPT(" ",100)),ROW($1:$10)*100-99,100),COLUMN(A1)))
★右にコピー

回答No.5

sakuuuuu

No.3です。

>１　改行コードをはずす。
>　ctrl+h で置換ボックスをあけ、
>　「検索する文字列」にctrl+j
>　「置換後の文字列」にspaceを設定し置換する。
>　　→　表示上は何も変わらないが置換はされている。

すみません、「置換後の文字列」でspaceでできなければ
カンマに置換して、区切り位置指定はカンマ区切りでやってみてください。
（どうやらスペースだとうまくいかないケースもありそうなので）

ちなみに、
この置換後の文字列は、「区切り位置」の区切り位置を指定する
文字となります。
セル内で使用していない文字を設定してください。
（セル内で区切り位置の文字列を使用しているとそこでセルが分割されてしまいます）

この「区切り位置」変更の手法は便利でよく使うので
覚えておいたほうが良いと思います。

回答No.4

zap35

マクロサンプルです
シートのコピーを作成してから実行するようにしています。

Sub Macro1()
Dim idx, cnt As Integer
Dim wkStr() As String
　　ActiveSheet.Copy after:=ActiveSheet
　　For idx = Range("A65536").End(xlUp).Row To 1 Step -1
　　　　If InStr(Cells(idx, "A"), Chr(10)) > 0 Then
　　　　　　wkStr = Split(Cells(idx, "A").Value, Chr(10))
　　　　　　cnt = UBound(wkStr)
　　　　　　Cells(idx, "A").Value = wkStr(cnt)
　　　　　　Do
　　　　　　　　cnt = cnt - 1
　　　　　　　　Cells(idx, "A").Insert shift:=xlDown
　　　　　　　　Cells(idx, "A").Value = wkStr(cnt)
　　　　　　Loop Until cnt = 0
　　　　End If
　　Next idx
End Sub

お礼

これです。
思っていたとおりのことができました。

これにもうひとつ追加でお願いしたいのですが、例えばA1に対応する値がB1に入っていた場合、A1から増えたセルの分だけ、Bのセルも増やすことはできますか？

A1にデータが5行入っていたら、セルが5個に増えますよね。
その個数（セル×５コ）だけ、Bも増えたりするとありがたいのですが…。

また、このマクロはA1～A100までのみが対象でしょうか？
A列全部が対象になってたりするとありがたいのですが。。。。

回答No.3

sakuuuuu

2ステップでできます。

１　改行コードをはずす
２　区切り位置の変更

１　改行コードをはずす。
　ctrl+h で置換ボックスをあけ、
　「検索する文字列」にctrl+j
　「置換後の文字列」にspaceを設定し置換する。
　　→　表示上は何も変わらないが置換はされている。

　　参照　セル内の改行を検索／置換する
　　http://pc.nikkeibp.co.jp/article/NPC/20060215/229489/

２　区切り位置の変更
　a列全体を選択、メニューから「データ」→「区切り位置」を選択
　「区切り位置指定ウィザード」が表示されるので
　「スペースによって右または左に揃えられた固定長フィールドのデータ」
　　→「次へ」→「次へ」→「完了」

これでＯＫ！

回答No.2

keirika

Sub Sample()

Dim i As Integer
Dim j As Integer
Dim Data As Variant

For i = 1 To 100
Data = Split(Cells(i, 1), Chr(10))
For j = 0 To UBound(Data)
Cells(i, j + 2) = Data(j)
Next j
Next i

End Sub

でどうでしょう。

回答No.1

mu2011

次の方法は如何でしょうか。
（１）A1:A100を選択→コピーしてワードに貼り付け
（２）ワードの置換で検索文字列欄に「任意指定の行区切り」、置換文字列欄に「段落記号」を特殊文字から選択→すべて置換
（３）置換後の文字列を選択→コピー→エクセルの別シートに形式を選択して貼り付け→テキストを選択→ＯＫ