[[20240820232357]] 『セル範囲の色だけをコピペしたい』(あるる) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『セル範囲の色だけをコピペしたい』(あるる)

あるセル範囲をコピーし、
別の場所に『セルの背景色のみ』ペーストしたいのですが、
方法はあるでしょうか。

調べた範囲では
一つ一つセルの色を取得し、コピペしていく方法を見つけました。
こういった方法が紹介されているということは、
まとめてセルの色だけをコピペするのは不可能、ということでしょうか。。。

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.