例えば、A1に「ABC」、A2に「DEF」と書いてあって、A3にこれらを結合して「ABCDEF」という文字列を作る場合は以下のマクロでできます。しかし、A1, A2の文字の色はコピーされません。A1が赤色であってもA3には全て黒色でコピーされてしまいます。
Sub con()
Range("A3").Value = Range("A1").Text + Range("A2").Text
End Sub
これを文字の色やボールド、斜体、アンダーラインなども含めてコピーする方法を教えてください。よろしくお願いします。
投稿日時 - 2005-07-30 00:06:22
こんにちは。
これは、コピーされる側個々のセルは、全体単位で、ペーストされる側は、個別の書式でプロパティが写されます。
Sub CopyFont1()
Dim a As Range, b As Range
Dim c As Variant, k As Integer
Set a = Range("A1")
Set b = Range("A2")
With Range("A3")
.Value = a.Value & b.Value
For Each c In Array(a, b)
With .Characters(k + 1, Len(c.Value) + k + 1).Font
.Bold = c.Font.Bold
.Color = c.Font.Color
.Italic = c.Font.Italic
.Name = c.Font.Name
.Size = c.Font.Size
.Underline = c.Font.Underline
End With
k = k + Len(c.Value)
Next
End With
End Sub
投稿日時 - 2005-07-30 12:07:48
お礼
回答ありがとうございます。求めていた結果が得られると同時に、マクロの書き方としてもたいへん参考になりました。セルに書き込んだ文章の重要部分を赤にしたりボールドにしているのですが、それらを集めてまとめる処理を行うために、この質問をさせていただきました。
投稿日時 - 2005-07-30 13:18:29
3人が「このQ&Aが役に立った」と投票しています
（１）＋や＆は文字列の「値」としての面だけを注目するものです。
Ｔｅｘｔプロパティも同じです。わかっておられると思いますが、原理的なことなので、まずしっかり認識すべきです。
（２）書式を含めて、移してくれるのは、Ｃｏｐｙですが、Ａ１セルとＡ２セルのどちらを優先するのかが決まっていません、決められません。
ですから質問には答えようがない。
（３）さらに、色は黒以外を優先、斜体はイタリック優先、アンダーラインはありを優先という条件を考えているとしたら、Ｃｏｐｙにはその条件はつけられません。Ａ１優先なら、Ａ１の書式をＡ３にコピーすればよいように思います。これはマクロの記録でも見てまねて、１、２行ですむでしょう。
（４）人間には常識的な（３）で触れた、優先の条件を、ＶＢＡの中に書きこめばできることですが、シコシコの世界で、面倒くさくて、今までそういう必要性を経験したことがないせいもあって、書く気がしない（略）。
黒色以外の優先関係、フォントの優先関係など細かい点はどうするのという問題もあります。
投稿日時 - 2005-07-30 08:14:43
試しに実行したところ以下のようなコードが得られましたが参考になりませんか？
A1の書式がA3にコピーされます。
Range("A1").Select
Selection.Copy
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
投稿日時 - 2005-07-30 00:46:57
お礼
回答ありがとうございました。参考にさせていただきます。
投稿日時 - 2005-07-30 13:14:17
>ちょっと考えるとコピーする文字の属性を一文字づつ新しい文字列に設定するVBAを書く必要があるかに思えます。これよりもっと簡単な方法はないのでしょうか？
私も、まとめてうまくやる方法が無いように思います。
fontStyleで標準・ボールド・斜体がまとめてできるのが救い。
---------------------------------------------------
Public Sub cat()
Dim s1 As Range, s2 As Range
Dim d As Range
Dim i, j
Set s1 = Range("A1")
Set s2 = Range("A2")
Set d = Range("A3")
d.Value = s1.Text & s2.Text
For i = 1 To Len(s1.Text)
d.Characters(i, 1).Font.Color = s1.Characters(i, 1).Font.Color
d.Characters(i, 1).Font.FontStyle = s1.Characters(i, 1).Font.FontStyle
d.Characters(i, 1).Font.Underline = s1.Characters(i, 1).Font.Underline
Next
i = Len(s1.Text)
For j = 1 To Len(s2.Text)
d.Characters(i + j, 1).Font.Color = s2.Characters(j, 1).Font.Color
d.Characters(i + j, 1).Font.FontStyle = s2.Characters(j, 1).Font.FontStyle
d.Characters(i + j, 1).Font.Underline = s2.Characters(j, 1).Font.Underline
Next j
End Sub
投稿日時 - 2005-07-30 00:39:24
お礼
回答および具体的なコードをありがとうございます。参考にさせていただきます。
投稿日時 - 2005-07-30 13:13:37
OKWaveのオススメ
おすすめリンク