指定した背景色のセルの値を削除するVBAを作りたい

質問

ご覧いただきありがとうございます。
VBA初心者です。
VBAを用いて指定し背景色のセルの値を全て削除したいと考えています。

シートには別の背景色のセルもあるため色のあるセルの値をすべて削除などは使えません。

For　Eachを用いて以下のような数式を用いようと思ったのですが、Ineriorはセルを対象としていないといけないようで、シート全体を対象としたい場合どうしたらよいか分かりません。
また終わりのところもよくわかっていません。
ご教授よろしくお願い致します。

Dim ws As warksheet
For Each ws In ActiveSheet
If ws.Interior.ColorIndex = RGB(252, 228, 214) Then ws.ClearContents

Next
End Sub

回答No.4

misatoanna

色は特定しません。選択されている１セルと同じ塗りつぶし色のセルを処理します。
------
Sub Test()
Dim col As Long, rng As Range
col = ActiveCell.Interior.Color
For Each rng In ActiveSheet.UsedRange
If rng.Interior.Color = col And rng.Value <> "" Then _
rng.ClearContents
Next
End Sub
-------
たとえば、ある色で塗りつぶされている1セルを選択した状態で実行すると、選択セルと同じ色で塗りつぶされたセルにデータがあれば、それを削除します。

回答No.3

imogasi

#2の補足に関して。
＞可能でしょうか。
可能でしょう。
しかし＃２に書いたように、セルの塗りつぶしの色（背景色という用語よりもこの用語が適当か。
そういうレベルの人において）の方式は、色々あるように思うので、そういう勉強が必要だと思います。
RGBとかColoerIndexとか、色の名前付き定数（組み込み定数）ちか、Findで書式で検索できる
とかを知らないように見えるが、質問者がそういうことをできるようになるには勉強が必要でしょう。
いま問題のシートで、＞値を削除したいセルの色コードが何かなどの話が全く出てこないのに、できますか？とはおかしい。読者・回答者にはそのシートを触れられるわけではないしね。
回答のコードは、それらを知らなくてもできるということが気に入って、WEBから拾ったものです。
（色コードはColorIndex=3と仮定して、コードを書く方がコードは簡略になるのだが。
またこういう補足の要求は、質問者とは別の関係者にやらせることから、出ていると推測するが、質問者のレベルで、他人がやる作業用のコードを作るなんて、慎重であるべきでしょう。
操作エラーの指摘や、チェックも組み込むなどを含めて、仕事に関する利用は、プロがやる領域と思います。

補足

最初の質問のコードにて記載していたため別途記載しておりませんでしたが、色はRGB(252, 228, 214) です。
主に私が使うＥｘｃｅｌでなるべく自分が使いやすいものにしたいと考えておりました。
今までは手作業だったためＶＢＡを勉強して業務改善をしていこうと考えております。

コードを変更して色選択やメッセージボックスを出す過程を省略しようと以下の通りに書き換えたのですが不具合が生じてしまいました。
マクロ実行時に選択していたセルに消したはずの数値が反映されてしまいます。
範囲内に１～3の数字が順番に並んでいたとして、最初にＡ１を選択していると
Ａ１　1
Ａ２　2
Ａ３　3
といった形で入力されてしまいます。
改変前のコードでも同様の事例が起こりました。

そもそもの貼り付けの際に何か誤ってしまっているかと思うのですがどの部分を修正すればよろしいのでしょうか。

Sub 色でデータ抽出()
Dim データ範囲 As Range
Dim 抽出セル As Range
Dim 抽出セル1 As Range

'Set データ範囲 = Range("A1").Current Region
Set データ範囲 = Range("A1:K10")
On Error GoTo エラー処理

Application.FindFormat.Clear
Application.FindFormat.Interior.Color = RGB(252, 228, 214)
Set 抽出セル = データ範囲.Find("", searchformat:=True)
Set 抽出セル1 = 抽出セル
抽出セル.Value = ""
Do
ActiveCell.Value = 抽出セル.Value
ActiveCell.Offset(1, 0).Select

抽出セル.Value = ""
Set 抽出セル = データ範囲.Find("", after:=抽出セル, searchformat:=True)

Loop While 抽出セル1.Address <> 抽出セル.Address
'-----
Application.FindFormat.Clear
エラー処理:
End Sub

回答No.2

imogasi

考えているセル範囲のセルを１つづつ、For Eachで捉え、セルの塗りつぶしの色が、
考えているものかどうか判定し、そうならセルの値をクリアする、でできるだろう。
VBA初心者ならそれでよいと思う。
ーー
ただし、エクセルで、最近（２００７？以後）では、書式を条件とする、検索ができるので、それでやる手もある。
Googleででも、照会すれば記事が見つかる。
まあVBAの上級者向けかと思う。VBAで検索　Findを使うことが、経験がいると思う。
https://kosapi.com/post-6337/
など。
Application.FindFormat.Interior.Color = 色
Set 抽出セル = データ範囲.Find("", searchformat:=True)
のあたりが、普通の「セルの値」を対象の検索と違う点です。
ただし、初心者なら、まずは、下記でやってみる方がよいだろう。
対象とするシートの検索範囲を下記では、Range("A1:K10")と、固定している。
実情に合わせて変えること。
標準モジュールで
ーー
Sub 色でデータ抽出()
Dim データ範囲 As Range
Dim 抽出セル As Range
Dim 抽出セル1 As Range
Dim 色セル As Range
Dim 色 As Long
'Set データ範囲 = Range("A1").CurrentRegion
Set データ範囲 = Range("A1:K10")
On Error GoTo エラー処理
MsgBox データ範囲.Address
Set 色セル = Application.InputBox("抽出するセルの色と同じセルの色の単体セルを選択してください。", Type:=8)
色 = 色セル.Interior.Color
If 色 = 0 Then
MsgBox "セル範囲ではなく単体のセルを選択してください。"
Exit Sub
End If
Application.FindFormat.Clear
Application.FindFormat.Interior.Color = 色
Set 抽出セル = データ範囲.Find("", searchformat:=True)
Set 抽出セル1 = 抽出セル
MsgBox 抽出セル.Address
抽出セル.Value = ""
Do
ActiveCell.Value = 抽出セル.Value
ActiveCell.Offset(1, 0).Select
MsgBox 抽出セル.Address
抽出セル.Value = ""
Set 抽出セル = データ範囲.Find("", after:=抽出セル, searchformat:=True)

Loop While 抽出セル1.Address <> 抽出セル.Address
'-----
Application.FindFormat.Clear
エラー処理:
End Sub
ーーー
例データ
A3　値　AA　書式塗りつぶしGreen
F7　値　BBB　書式塗りつぶしGreen
B9　値　CC　書式塗りつぶしGreen
でテスト実施。
結果
A３、F7、B９のセルは空白になった。
書式もクリアするなら、コードを追加してください。上記コードで２か所。
ーー
書式の設定は、色々やり方があると思う。
ここでは、Interior.Color(またはInterior.Color.Index）で設定されたものとしている。
それ以外ならば、勉強が必要。

補足

ご回答ありがとうございます。
削除したいＥｘｃｅｌの色が決まっているのですが途中の色を選ぶ過程を省略することは可能でしょうか。
ご回答いただけますと幸いです。
よろしくお願い致します。

回答No.1

kkkkkm

全てのセルでしたら以下のようにすればいいと思いますが、とんでもなく時間がかかると思います。

Sub Test()
Dim mRange As Range
For Each mRange In Cells
If mRange.Interior.Color = RGB(252, 228, 214) Then mRange.ClearContents
Next
End Sub

全てのセルではなくある程度範囲を指定して実行したほうがいいと思います。
For Each mRange In Cells
↓
For Each mRange In Range("A1:X10000").Cells