[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『セル範囲の色だけをコピペしたい』(あるる)
あるセル範囲をコピーし、
別の場所に『セルの背景色のみ』ペーストしたいのですが、
方法はあるでしょうか。
調べた範囲では
一つ一つセルの色を取得し、コピペしていく方法を見つけました。
こういった方法が紹介されているということは、
まとめてセルの色だけをコピペするのは不可能、ということでしょうか。。。
Range(Cells(9, 3), Cells(9, 範囲)).Copy
ここのセル背景色を2行上の範囲にペーストする方法を教えてください。
Range(Cells(7, 3), Cells(7, 範囲)).Paste
(範囲、となっているのは変数です)。
< 使用 Excel:Excel2021、使用 OS:Windows11 >
Range.PasteSpecial メソッド を使うと貼り付ける内容を指定できますが、 https://learn.microsoft.com/ja-jp/office/vba/api/excel.range.pastespecial
指定できる種類は、以下のものに限られます。 https://learn.microsoft.com/ja-jp/office/vba/api/excel.xlpastetype
それ以外は、セル書式のプロパティをコツコツ1つづつ指定する他ありません (´・ω・`) 2024/08/21(水) 08:41:59
マクロを使って1つずつ背景色を取り出して2行上のセルに設定、というのが常套手段かと 思います。下記のサンプルはセルを選択してから実行すると2行上のセルに同じ背景色を 設定します。
Sub Smaple()
Dim Rng1 As Range
Dim Rng2 As Range
Dim n As Long
'選択されたセル範囲を設定
Set Rng1 = Selection
'選択されたセルが3行目以降なら2行上のセルに背景色を設定
If Rng1.Row > 2 Then
Set Rng2 = Rng1.Offset(-2)
For n = 1 To Rng1.Cells.Count
Rng2.Cells(n).Interior.Color = Rng1.Cells(n).DisplayFormat.Interior.Color
Next n
End If
End Sub (通りすがり助六) 2024/08/21(水) 08:47:52
■1
断言しませんが、【1つのセル範囲】のうち【塗りつぶしの色】が、バラバラな場合、多分無理です。
バラバラでなければ、適当なセル(たとえば左上セル)を参照すればよいだけなので可能。
■2
【形式を選択して貼り付け】に、塗りつぶしのみというオプションがあれば別ですが無かったと思いますから、既知の方法にするか、書式を貼付してから必要の無い書式を解除すると考えてみてはどうでしょうか?
■3
なお、「2行上の範囲」は、↓で表現可能です。
セル(範囲).offset(-2)
(もこな2 ) 2024/08/21(水) 08:48:47
発言重なっていますが、色が付いている場合にだけ転記する点に注意下さい。
Sub test()
Dim rng As Range, r As Range
Set rng = Cells(3, 1).Resize(1, 5) '例です
For Each r In rng
If r.Interior.Pattern <> xlNone Then
r.Offset(-2).Interior.Color = r.Interior.Color
End If
Next
End Sub
なお、条件付き書式による色は考慮の対象外です。
# セル位置が逆でしたね。修正しました。(8/22)
# また、転記先のセルには色がついていない前提でした。
(xyz) 2024/08/21(水) 09:36:23
>方法はあるでしょうか。
手動で出来ないことはVBAだからといってできません。
が、手動でたくさんの手順を踏めば、やりたいことは出来るはずですので、
その手順を自動化して、標準の機能では出来ないことを、
新たな機能として自作で追加出来るのが、VBAのいいところです。
今回の件の場合は、
対象範囲を順に見て行って、対応するセルの色と同じ色に塗っていけば
いいですよね?
(まっつわん) 2024/08/21(水) 10:53:19
■4
>一つ一つセルの色を取得し、コピペしていく方法を見つけました。
おそらくですが、そのコードはxyzさんが提示されたようなコードだったかと思います。
言葉の綾だとは思いますが、狭義でいえばコピペではなく同じ色を設定しているだけです。
ちなみにxyzさんのコードだと、【元データ側が塗りつぶし設定がされている場合のみ】処理しますが、それではマズイ場合は↓のようになるかと思います。
Sub 研究用1()
Dim 範囲 As Long
Dim MyRNG As Range
範囲 = 7
'▼セル範囲を巡回して、対応するセルと同じ色になるよう設定
For Each MyRNG In ActiveSheet.Cells(9, 3).Resize(, 範囲 - (3 - 1))
If MyRNG.Interior.ColorIndex = xlNone Then
MyRNG.Offset(-2).Interior.ColorIndex = xlNone
Else
MyRNG.Offset(-2).Interior.Color = MyRNG.Interior.Color
End If
Next
End Sub
※要は、真・偽でそれぞれ処理すれば対応できるという話です。
■5
また、既に述べたように、対象のセルがすべて同じ色であれば一括で処理できます。
Sub 研究用2()
Dim 範囲 As Long
範囲 = 7
With ActiveSheet.Cells(9, 3).Resize(, 範囲 - (3 - 1))
'▼全体を一括して左上セルと同じ色になるよう設定
If .Cells(1, 1).Interior.ColorIndex = xlNone Then
.Offset(-2).Interior.ColorIndex = xlNone
Else
.Offset(-2).Interior.Color = .Cells(1, 1).Interior.Color
End If
End With
End Sub
■6
このほか、あくまで"コピペ"にこだわるということならば↓のようになるでしょう。
(元データ側の書式が塗りつぶし色以外は設定されることはないということなら、解除部分は要りません。)
Sub 研究用3()
Dim 範囲 As Long
Dim MyRNG As Range
範囲 = 7
With ActiveSheet.Cells(9, 3).Resize(, 範囲 - (3 - 1))
.Copy
'▼書式を貼り付け
.Offset(-2).PasteSpecial Paste:=xlPasteFormats
'▼余計な情報(たとえば罫線と文字色)を解除(デフォルトに設定)
.Offset(-2).Font.ColorIndex = xlAutomatic
.Offset(-2).Borders.LineStyle = xlNone
.Offset(-2).Borders(xlDiagonalDown).LineStyle = xlNone
.Offset(-2).Borders(xlDiagonalUp).LineStyle = xlNone
End With
End Sub
※いずれも研究用として提示しますので、ステップ実行等で何をやっているか調べてみてください。
(もこな2 ) 2024/08/21(水) 20:46:38
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.