Excel-VBA セルのデータ書出し

質問

セル「A1」に次のデータが在るとします。
セルの書式設定は「折り返して全体を表示する」です。
金田
曽我部
武田
安藤
森田
▼やりたい事は、
セル[A1]のデータを、一名ずつに分解して⇒セル[B1・B2・B3・B4・B5・・・]へ
VBAで書き出したいのですが初心者にてコードが分かりません。
サンプルコードを紹介していただきたいのですが、
よろしくお願い致します。

回答No.2

mu2011 · ベストアンサー

一例です。
名前は改行（Alt＋Enter）している事としています。

a = Split(Cells(1, 1), vbLf)
For i = LBound(a) To UBound(a)
Cells(i + 1, 2) = a(i)
Next

お礼

mu2011さん回答有難うございます。
実を言いますと「ANo.4」回答とどちらを使用するか迷いましたが、
「ANo.3 Split」を採択しました。
理由は、複数のセルの値を、Ｂ列配下へ書き出すことになる事から、データカウントが必須となります。等々からご教授いただいた手法を実運用したいと思います。
以上

回答No.5

end-u

>課題の説明不足があったかもしれませんが、
>実際は複数のセルの値をB列配下へ次々と下記加える運用となる事から...

その場合もちょっとした応用のみ。
件数を取得する必要もありません。

Sub test2() 'A列のデータ範囲を選択して実行
　　Dim s As String
　　Selection.Copy
　　With New DataObject
　　　　.GetFromClipboard
　　　　s = .GetText
　　　　.Clear
　　　　.SetText Replace$(s, """", "")
　　　　.PutInClipboard
　　End With
　　ActiveSheet.Paste Range("B1")
End Sub

お礼

end-uさん、ご丁寧な回答有難うございます。
締め切り後の回答にてQ&Aが出来なくなりました。
新たに「Excel-VBA セルのデータ書出し(Q2)」で質問しなおします。
ご教授宜しくお願い致します。

回答No.4

end-u

Sub test()
　　With New DataObject
　　　　.Clear
　　　　.SetText Range("A1").Value
　　　　.PutInClipboard
　　End With
　　ActiveSheet.Paste Range("B1")
End Sub

上記コードを標準モジュールに書いて
VBEメニュー[ツール]-[参照設定]の「参照可能なライブラリファイル」に
Microsoft Forms 2.0 Object Library
をチェックして追加します。
（UserFormを追加する事でも参照追加されます）
その後、コード実行。

手作業では、セルまるごとコピーするのではなく
A1セル編集状態で文字列だけコピー（数式バーの内容だけコピー）し
B1セルにペースト。
..と同じような意味のコードです。

補足

end-uさん回答有難うございます。
思いもよらない手法をご教授いただき感謝しています。
課題の説明不足があったかもしれませんが、
実際は複数のセルの値をB列配下へ次々と下記加える運用となる事から、
ご教授いただいた「PutInClipboard」等は件数を取得できないように思え、
今回は運用を見合わせました。
しかし必ず使用する機会が有ろうかと思います。
貴重な手法として留めおかさせていただきます。
以上

回答No.3

imogasi

既に回答があるように、わたしも普通は、Split関数を使う。
それには
（１）Split関数の存在とどういう機能か
（２）セル内改行が（文字コード10） Chr(10) で成り立っていること
（３）その他
を知っていることが必要です。
--
Split以外の回答を挙げておく。Instr 関数利用の繰り返し。１セル１０氏名までと仮定。
同列に多数セルある場合は下記のk=1を除いて(各セルの繰返しの外に出して）全体を繰り返しする。
ーーー
Sub test01()
k = 1 'B列の第１行目からに結果を出す
x = Cells(1, "A")
s = 1
For i = 1 To 10
p = InStr(s, x, Chr(10))
If p = 0 Then Exit For
Cells(k, "B") = Mid(x, s, p - s)
k = k + 1
s = p + 1
Next i
End Sub

補足

回答有難うございました。
InStr関数について良く理解できました。
しかし最後の値が出力できませんでしたが、次の様に加筆する事で成功しました。
x = Cells(1, "A") 　↓
x = Cells(1, "A") & Chr(10)

それと、現実は１セル１０氏名と固定できないため、実運用を見合しました。
以上

回答No.1

okormazd

区切りが何なのか解らないが、1.はchr(10)で改行している場合(" "でも動くか)、2.は" "が区切りの場合です。

たとえば、
1.
A1形式
C1:F1を使っていないなら、「区切り位置」を利用して下記のように。

Sub test1()

Range("A1").TextToColumns Destination:=Range("B1"), OtherChar:=Chr(10)
Range("C1:F1").Copy
Range("B2").PasteSpecial Transpose:=True
Range("C1:F1").ClearContents

End Sub

2.
R1C1形式
ふつうにVBAならたとえば下記のように。

Sub test2()

s = ActiveSheet.Cells(1, 1)
l = Len(s)
k = 1
i = 1
While i < l
j = InStr(i, s, " ")
If j = 0 Then j = l + 1
ActiveSheet.Cells(k, 2) = Mid(s, i, j - i)
i = j + 1
k = k + 1
Wend

End Sub

補足

目的の結果が得られませんでした。