エクセル。複数行あるセルの分割はできますか？

こんにちは。
教えてください！
たとえば、B1のセルに次のように3行でデータが入力されていたとします。
B1「日本
　　アメリカ
　　イギリス」
これをそれぞれ分割して次のようにできる関数はありますか？
B1「日本」
B2「アメリカ」
B3「イギリス」

それが簡単にできると仕事がスムーズになるので助かります。
もし次のことも解決できる方法があれば教えてもらえませんか？
A1「8月30日」
B1「日本、アメリカ、イギリス(3行で入ってます)
C1「出発」
というようなデータがあって、B1をそれぞれの国で分割して、A1とC1のデータをアメリカが入っている行、イギリスが入っている行に自動的にコピーされる。
これは関数ではなくて、マクロになるのかな？とも思うのですが、「分割が行われた行までコピー」というやり方がさっぱりわからないでいます。(その前に分割する方法が分からないんですけど・・・)
ちなみに、データがずらーっと並んでいるリストの一部にあるB1のようなデータを整理したいというのが、目的になります。

どうぞ宜しくお願い致します。

No.1 ベストアンサー 回答者： KenKen_SP 回答日時： 2008/08/30 11:52

こんにちは。

よくよくテストして下さい。

Sub Sample()

　　Dim nLastRow As Long
　　Dim i　　　　As Long
　　Dim j　　　　As Long
　　Dim s　　　　As String
　　Dim v

　　nLastRow = Cells(Rows.Count, "A").End(xlUp).Row
　　
　　Application.ScreenUpdating = False
　　For i = nLastRow To 2 Step -1 ' // 2行目まで
　　　　s = Cells(i, "B").Text
　　　　If Len(s) > 0 Then
　　　　　　v = Split(s, vbLf)　　' // セル内改行で配列化
　　　　　　If UBound(v) > 0 Then
　　　　　　　　Rows(i + 1).Resize(UBound(v)).Insert
　　　　　　　　For j = 0 To UBound(v)
　　　　　　　　　　Cells(i + j, "A").Value = Cells(i, "A").Value
　　　　　　　　　　Cells(i + j, "B").Value = v(j)
　　　　　　　　　　Cells(i + j, "C").Value = Cells(i, "C").Value
　　　　　　　　Next
　　　　　　End If
　　　　End If
　　Next

End Sub

この回答へのお礼

お礼が遅くなって申し訳ありませんでした。
どうもありがとうございました。

お礼日時：2009/08/17 16:46

No.8 回答者： mike_g 回答日時： 2008/08/30 18:30

１．セル B1 を例えばセル E1 にコピー＆ペースト

２．セル E1 を選択して、[データ]→[区切り位置]を実行
３．“カンマやタブなどの…に区切られたデータ”に目玉入れて[次へ]
　　をクリック
４．“その他”の右側のボックス内にマウスカーソルを置いて Ctrl+J
　　をパシーッ
５．[完了]をクリック
６．範囲 E1:G1 を選択して[コピー]
７．セル B1 を選択して、[編集]→[形式を選択して貼り付け]を実行
８．“行列を入れ替える”にチェックを入れて[OK]をクリック
９．範囲 A1:C3 を選択
10．[編集]→[ジャンプ]→[セル選択]を実行
11．“空白セル”に目玉を入れて[OK]をクリック
12．キーボードから =A1 を入力して Ctrl+Enterキーを「エイヤッ！」
　　と叩き付け

この回答へのお礼

お礼が遅くなって申し訳ありませんでした。
どうもありがとうございました。

お礼日時：2009/08/17 19:06

No.7 回答者： n-jun 回答日時： 2008/08/30 15:36

ANo.5です。

私も横道にそれまして申し訳ないですが。
ANo.6さん、回答ありがとうございました。

この回答へのお礼

お礼が遅くなって申し訳ありませんでした。
どうもありがとうございました。

お礼日時：2009/08/17 18:58

No.6 回答者： mitarashi 回答日時： 2008/08/30 14:47

横道に外れてすみません。

A No.5のn-junさんのご質問に対してですが、
#2→#3の間違いです。申し訳ありません。

この回答へのお礼

お礼が遅くなって申し訳ありませんでした。
どうもありがとうございました。

お礼日時：2009/08/17 18:39

No.5 回答者： n-jun 回答日時： 2008/08/30 14:04

ANo.2です。

直接の回答ではないですが。

ANo.4さん
＞#2とやっている事は同じですが、中間結果のセルの値を使用していないところが違いです。
今一つわかっていないのですが、もしかしてシート２に書き出していることでしょうか？
ご指導願えれば幸いです。

この回答へのお礼

お礼が遅くなって申し訳ありませんでした。
どうもありがとうございました。

お礼日時：2009/08/17 17:26

No.4 回答者： mitarashi 回答日時： 2008/08/30 12:17

久しぶりに真面目に関数を考えてみました。

やはり#1のVBAの方が好きですね。小難しいのはどちらも同様だと思います。
#2とやっている事は同じですが、中間結果のセルの値を使用していないところが違いです。（だから優れていると言う訳ではありませんが）
=LEFT(A1,SEARCH(CHAR(10),A1)-1)
=MID(A1,SEARCH(CHAR(10),A1,1)+1,SEARCH(CHAR(10),A1,SEARCH(CHAR(10),A1,1)+1)-SEARCH(CHAR(10),A1,1)-1)
=MID(A1,SEARCH(CHAR(10),A1,SEARCH(CHAR(10),A1,1)+1)+1,LEN(A1)-SEARCH(CHAR(10),A1,SEARCH(CHAR(10),A1,1)))

この回答へのお礼

お礼が遅くなって申し訳ありませんでした。
どうもありがとうございました。

お礼日時：2009/08/17 17:20

No.3 回答者： CaveatEmptor 回答日時： 2008/08/30 12:08

もとにあるB1のデータを「日本」してしまうと、他に元データを置いておかない限り分割ができないのでB2,B3,B4に分割していきます

B2にはMID(B1,1,FIND(CHAR(10),B1,1))

B3にはMID(B1,FIND(CHAR(10),B1,1),FIND(CHAR(10),B1,FIND(CHAR(10),B1,1)+1)-FIND(CHAR(10),B1,1))

B4にはMID(B1,FIND(CHAR(10),B1,FIND(CHAR(10),B1,1)+1)+1,LEN(B1))

と入れてみて下さい。

２つめの質問については自動的にコピーということになるとマクロを使うことになります。

この回答へのお礼

お礼が遅くなって申し訳ありませんでした。
どうもありがとうございました。

お礼日時：2009/08/17 17:15

No.2 回答者： n-jun 回答日時： 2008/08/30 12:05

Sub　test()

　Dim　i　As　Long,　j　As　Integer
　Dim　k　As　Long
　Dim　v,　w,　x

　With　Worksheets("Sheet1")　'シート名変更要
　　　　　　v　=　Range(.[A1],　.Cells(Rows.Count,　1).End(xlUp).Resize(,　3)).Value
　End　With

　ReDim　x(1　To　3,　1　To　1):　k　=　1

　For　i　=　1　To　UBound(v,　1)
　　　　　w　=　Split(v(i,　2),　vbLf)
　　　　　　　　　For　j　=　0　To　UBound(w)
　　　　　　　　　　　　　x(1,　k)　=　v(i,　1)
　　　　　　　　　　　　　x(2,　k)　=　w(j)
　　　　　　　　　　　　　x(3,　k)　=　v(i,　3)
　　　　　　　　　　　　　k　=　k　+　1
　　　　　　　　　　　　　ReDim　Preserve　x(1　To　3,　1　To　k)
　　　　　　　　　Next
　Next

　With　Worksheets("Sheet2")　'書き出すシート
　　　　　　.Range("A:A").NumberFormat　=　"m""月""d""日"""
　　　　　　.Range("A1").Resize(k　-　1,　3).Value　=　Application.Transpose(x)
　End　With
　Erase　v,　w,　x
End　Sub
ご参考まで。

この回答へのお礼

お礼が遅くなって申し訳ありませんでした。
どうもありがとうございました。

お礼日時：2009/08/17 17:05