VBA セル内改行+他セルの文字をカット＆ペースト

質問

A1セル内文字の最後部分にカーソルを持っていって、Alt+Enterを押してA1セルを2行に改行する、

B1にある値をカットして、A1の改行した部分に貼り付け

というマクロを作るべく、「マクロの記録」をしてみたところ、A1のテキストがそのままマクロに書き込まれてしまって応用ができないです。

改行部分に貼り付けするにはB1セルの値はコピーではなくカットが必要だと思いますが、これも「マクロの記録」だと動作ではなくテキストそのものが書き込まれてしまい、応用が効きません。

Sub A1改行カットペースト()
'
' A1改行カットペースト Macro
'
'
ActiveCell.FormulaR1C1 = "RO20-001" & Chr(10) & ""
Range("B1").Select
ActiveCell.FormulaR1C1 = ""
Range("A1").Select
ActiveCell.FormulaR1C1 = "RO20-001" & Chr(10) & "8/7到着"
Range("F4").Select
End Sub

"RO20-001"と"8/7到着"はA1とB1の値であって、この記述ではこのマクロをループさせた時、他の全部のセルに"RO20-001"と"8/7到着"が貼りついてしまいます。

改行やテキストのカット＆ペーストの「動作」はどのように記述すれば良いのでしょうか？

どなたかご存じの方がいらっしゃいましたら、教えて下さい。

よろしくお願いします。

回答No.1

kkkkkm · ベストアンサー

とりあえずA1だけですが
Range("A1").Value = Range("A1").Value & Chr(10) & Range("B1").Value
Range("B1").ClearContents

お礼

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

出来ました。。。
ずっと私を苦しめ続けたコツコツ作業がオートになりました。。。( ；∀；)

Dim i As Long
For i = 1 To 200
Range("A" & i).Value = Range("A" & i).Value & Chr(10) & Range("B" & i).Value
Range("B" & i).ClearContents
Next i
End Sub

これで作業時間が圧倒的に短縮されます！
朝から感動で震えております！！！

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

回答No.4

masnoske

No.3です。
訂正します。
CharではなくChrです。

お礼

補足ありがとうございます。

そうですねCharは歌手ですね。
そっちも好きではあります。

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

回答No.3

masnoske

文字入力領域の値を貼っても、その値が張り付くだけです。
なので、
Range("A1") = Range("A1") & Range("B1")
とすれば、セル値を連結できます。
セル内改行は、Char(10)なので、これを間に挟めば良いです。
Range("A1") = Range("A1") & Char(10) &
Range("B1")

お礼

ご回答ありがとうございます。
下記でやってみましたが、「Endに対するNextが無い」といったエラーが出ました。

Dim i As Long
For i = 1 To 200
Range("A"&i) = Range("A"&i) & Range("B"&i)
。
Range("A"&i) = Range("A"&i) & Chr(10) & Range("B"&i)
Next i
End Sub

でもセル内改行はChr(10) なのですね、本当に勉強になります。
ありがとうございました。

回答No.2

HohoPapa

添付画像左側の状態で、
B1をマウスで右クリック
コンテキストメニューから「コピー」を左クリック
A1セルをマウスで左クリック
マクロを実行　と操作したときに
添付画像右側の状態にしたい。

つまり、
A1に埋まっている内容の下に1行開けて、
B1に埋まっている内容を追記したい。
かつ、この動作を対象セルを問わない機能にしたい。
この理解でいいでしょうか。

クリップボードを扱う必要があり、
若干難易度が上がります。
少なくとも、
マクロの記録機能で作成したコードを手直しする方法では
解決できません。

https://www.moug.net/tech/exvba/0150091.html
↑で説明する参照設定を行い
後記のコードを実行することとなります。

Sub Sample3()

　'参照設定が必須
　'https://www.moug.net/tech/exvba/0150091.html

　Dim wkText As String

　With New MSForms.DataObject

　　.GetFromClipboard　　''変数のデータをDataObjectに格納する

　　If ((Left(.GetText, 1) = """") And (Right(.GetText, 3) = """" & vbCrLf)) Then
　　　'MsgBox "Hit"
　　　wkText = Mid(.GetText, 2, Len(.GetText) - 4)
　　Else
　　　wkText = .GetText
　　End If

　　ActiveCell.Value = ActiveCell.Value & vbLf & wkText

　End With

　Application.CutCopyMode = False

End Sub

お礼

ご回答ありがとうございます。
下記丸写しでやってみたところ、「ユーザ定義型は定義されていません」とのエラーが出ました。

　Dim wkText As String
　　With New MSForms.DataObject
　　　　.GetFromClipboard　　''変数のデータをDataObjectに格納する
　　　If ((Left(.GetText, 1) = """") And (Right(.GetText, 3) = """" & vbCrLf)) Then
　　　'MsgBox "Hit"
　　　wkText = Mid(.GetText, 2, Len(.GetText) - 4)
　　Else
　　　wkText = .GetText
　　End If
　　　　ActiveCell.Value = ActiveCell.Value & vbLf & wkText
　End With
　　Application.CutCopyMode = False
End Sub

事前に何か設定が必要なのですね。
参照サイトを見てみます。

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