マクロ作成で困っています。

vbaで複数行の値を書式ごと1行にコピーするのを書きたいのですが、
どう書けばいいのでしょうか？

質問者からの補足コメント

• 説明が足らず申し訳ありません
  
  例えば、
  A1、B1にそれぞれ 1(2) , 2(3) ※()内の数字は下付き文字
  と値があった場合に
  下付き文字などもそのまま結合してC1に入れるのを書きたいです。

    補足日時：2021/12/14 14:53

No.4 ベストアンサー 回答者： Qchan1962 回答日時： 2021/12/14 17:45

＃２です

＞下付き文字などもそのまま結合してC1に入れるのを書きたいです。
Charactersを使って取得します。（調べてみてください）

セル配置はあえて違う場所にしていますが、後から理解し易く？
むしろ複雑にしまっているかも知れません。

取得と出力を分けて書いてあります。
配列について分からなければ、少し調べてくださいね。

装飾のオプションは多数有るので今回は、ご質問のフォントアンダーバーのみです。装飾についても調べると色々ありますので一度ググってみるのが良いと思います。
Sub sample()
Dim Rng As Range, r As Range
Dim i As Long, n As Long
Dim tp As Integer
Dim Str()

Set Rng = Range("B2:B4")　'対象範囲
For Each r In Rng '配列サイズ設定の為のループ
i = i + Len(r.Text)
Next
ReDim Str(i, 2) '配列サイズ設定
n = 1
'取得
For Each r In Rng
For i = 1 To Len(r.Text)
If r.Characters(i, 1).Font.Underline = 2 Then
tp = 2
Else
tp = -4142
End If
Str(n, 1) = r.Characters(i, 1).Text
Str(n, 2) = tp
n = n + 1
Next
Next

'出力
With Range("C2")　’出力セル
.Clear
For n = 1 To UBound(Str, 1)
If .Text <> "" Then
.Value = .Text & Str(n, 1)
Else
.Value = Str(n, 1)
End If
Next
For i = 1 To Len(.Text)
.Characters(i, 1).Font.Underline = Str(i, 2)
Next
End With
End Sub

この回答へのお礼

ご回答ありがとうございます。お礼が遅れてしまいすいませんm(_ _)m

この回答からヒントを得て、書きたかったものを書くことができました。

お礼日時：2021/12/17 19:40

No.5 回答者： Qchan1962 回答日時： 2021/12/14 18:00

＃４

投稿して気が付きました。
エラーでは無いですが、配列名はStr()適切ではないと思います
　VBA関数 Str(number)　があるので混同する可能性があります

使用する場合は、他の名前に変更してください。

すみません。

No.3 回答者： めぐみん_ 回答日時： 2021/12/14 15:13

No.1です。

補足を見て。
多分初級レベルからみるとセルの値ではなく装飾ですよね？
無理な気もしますよ。
地道に１文字ずつ装飾されているのかどうかを調べてって感じじゃないですかね。

見た目は１つのセルにあるデータのように見えても、値と装飾は管理が別だと思います。

この回答へのお礼

回答して頂きありがとうございます。

値とはまた扱いが違うとなると確かに厳しそうですね。

あと回答の内容を見て少し気になったのですが、

＞地道に１文字ずつ装飾されているのかどうか調べて...
もしこれをやるとしたらどういう風に動かすのですか？

できれば教えてほしいです。

お礼日時：2021/12/14 15:50

No.2 回答者： Qchan1962 回答日時： 2021/12/14 11:02

こんにちは

＞書式ごと1行に
１セルかな？、行列の入れ替えをしたいのかな？

入れ替えて貼り付けの場合、

Sub test()
Range("A1:A5").Copy
Range("B1").PasteSpecial Transpose:=True
Application.CutCopyMode = False
End Sub

貼り付け領域の問題でコピー元と貼り付け先は重ねる事が出来ません。
上記で
Range("A1").PasteSpecial Transpose:=True　はダメですよ

この場合、
Range("A2:A5").Copy
Range("B1").PasteSpecial Transpose:=True
などでA1セルをそのまま使うとか、、、
更に　.Cut　でやりたいところですが、CutにはオプションがありませんのでCopy、PasteSpecial Transpose:=True　後に　不要範囲を削除するような事になるかと思います。

No.1 回答者： めぐみん_ 回答日時： 2021/12/14 04:23

こうゆう事ですか？

Ａ１～Ａ５には =TODAY() が入っておりセルの書式設定で表示を変えてます。
その表示の値を取得するために .Value ではなく .Text を使いました。

Sub megu()
Dim v(), r As Range, i As Long

i = 0
ReDim v(0)

For Each r In Range("A1:A5")
ReDim Preserve v(0 To i)
v(i) = r.Text
i = i + 1
Next

Range("B1").Value = Join(v, Chr(10))
End Sub