セルの自動塗りつぶし

質問

エクセルで、範囲H5:O104にランダムに商品名が記入されています。特定商品名だけ赤色で塗りつぶししたいのですが、現在は文字列の検索で１つづつ探して手作業で行っています。そこで例えば、セルＡ１に商品名を入力することで自動的にＡ１と同一商品名のセルを赤色で塗りつぶす方法があればと考えます。よい方法があったら是非教えて下さい。

回答No.5

mshr1962 · ベストアンサー

ボタンのタイミングというなら
Private Sub CommandButton1_Click()
Dim RG As Range
For Each RG In Range("H5:O104")
If RG = RANGE("A1") Then
RG.Interior.ColorIndex = 3
End If
Next RG
End Sub

お礼

出来ました！
まさかこんな短いスクリプトで実現できるとはビックリしました。
ありがとうございます。

回答No.6

Wendy02

こんにちは。
#4 の回答者です。

>ツールバーのフォームからコマンドボタンを貼り付けてコマンドボタンを押したとき実行するように改変するには大変ですか？(^^ゞ

それは難しくありません。
フォームのボタンを右クリック－ボタン登録－新規作成

Sub ボタン1_Click()

End Sub

というのが出てきますから、

このコードを
'------------------------------------
　 Dim Fadd As String
　　Dim c As Range
　　Dim SetRng As Range
　　Set SetRng = Range("H5:O104")　'検索範囲

　　Set c = SetRng.Find( _
　　What:=Range("A1").Value, _
　　LookIn:=xlValues, _
　　LookAt:=xlWhole, _
　　MatchCase:=False, _
　　MatchByte:=False)
　　If Not c Is Nothing Then
　　　　Fadd = c.Address
　　　　Do
　　　　　　c.Interior.ColorIndex = 3 '色番号
　　　　　　Set c = SetRng.FindNext(c)
　　　　　　If c.Address = Fadd Then Exit Sub
　　　　Loop Until c Is Nothing
　　End If
　　Set SetRng = Nothing
'-----------------------------------　　

二行の間に以上のコードを入れてあげれば済みます。
換えたところは、A1 限定の　Target を、Range("A1") に換えただけです。なお、LookAt:=xlWhole　の"xlWhole" を、xlPart とすれば、部分検索もします。

お礼

ありがとうございます。出来ました。今朝から参考書を片手に解読しながら勉強させていただきました。あいまい検索のような設定もxlPartとすれば出来るのですね。今後の助けになります。この度は本当にお世話になりました。

回答No.4

Wendy02

こんばんは。

マクロでしたら、イベントドリブン型でよいと思います。

シート・マクロの取り付け方：

マクロを実行しようとするワークシートのシートタブ(下部のSheet1,Sheet2 ...)を右クリックすると、「コードの表示(V)」というメニューがありますから、それをクリックしてください。そして、開いた画面に、以下のコードを貼り付けて、Alt + Q で閉じれば設定は完了です。

A1 に入力して試してみてください。
-----------------------------------------------

Private Sub Worksheet_Change(ByVal Target As Range)
　　Dim Fadd As String
　　Dim c As Range
　　Dim SetRng As Range
　　Set SetRng = Range("H5:O104")　'検索範囲

　　'A1 に代入すると、色を換える
　　If Target.Address <> "$A$1" Then Exit Sub
　　Set c = SetRng.Find( _
　　What:=Target.Value, _
　　LookIn:=xlValues, _
　　LookAt:=xlWhole, _
　　MatchCase:=False, _
　　MatchByte:=False)
　　If Not c Is Nothing Then
　　　　Fadd = c.Address
　　　　Do
　　　　　　c.Interior.ColorIndex = 3 '色番号
　　　　　　Set c = SetRng.FindNext(c)
　　　　　　If c.Address = Fadd Then Exit Sub
　　　　Loop Until c Is Nothing
　　End If
　　Set SetRng = Nothing
End Sub

---------------------------------------------------
'色番号(ColorIndex)
'黒(1),白(2),赤(3),黄緑(4),青(5),黄色(6),ピンク(7),
'水色 (8), 茶(9), 緑(10), 藍(11), 黄土色(12), 紫(13), 濃緑(14)
'灰色 (15), 濃い灰色(16),淡い水色(34),黄緑 (35),薄い黄色(36)
'ゴールド(44),ローズ(38),オレンジ(46)

なお、塗りつぶしの場合は、一般的には、パステルカラーのほうがよいです。

お礼

出来ました。Ａ１に入力してリターンキーを押下することでイベントが発生し実行されるのですね。
ツールバーのフォームからコマンドボタンを貼り付けてコマンドボタンを押したとき実行するように改変するには大変ですか？(^^ゞ
でもでも素晴らしいアイデアいただき感謝しています。
ありがとうございました。

回答No.3

imogasi

＞一旦塗りつぶしたセルは塗りつぶしたままにしておきたいので
このニーズは初めてこの質問コーナーで見るように思います。条件付き書式ではダメです。
VBAでやる必要があります。
ーー
消えても良い場合は
参考までに条件付書式では
例データA1　とB１：D4
a s w w
d g s
a h d
g q a
ーー
B1:D4を範囲指定して、
書式ー条件付書式ー数式が　で
=B1=$A$1
と入れて、セルのパターン色など設定ーOK
でできます。
しかしA1の値を変えると変えた値での同じ値のセルは色付けし
元の該当セルは無色とかになります。
ーー
VBAでは、そのロジックは、上記例で言えば、B1:D4の全セルについてA1と等しいかどうか判別し、等しければ、色をつける。
ー
またはB1:D4のセル範囲に対し、FindメソッドでA1セルの値と同じものを探し、見つかったセルに色付けする。少しこちらのコードの方が熟練度がいる。
＝＝
こういうので良ければ
例データ　A１：A4とB1:D4
a s w w
d d g s
h a h d
w g q a
A1:A4に入れた文字列とB1:D4の範囲内で等しいセルを色付けする。
ー
B1:D4を範囲指定して
書式ー条件付書式
数式が　のところで
=OR(B1=$A$1,B1=$A$2,B1=$A$3,B1=$A$4)
と入れる
書式設定ーOk
上記では４つまでだが式が記述できる制限内なら５つ以上も可能。

お礼

数えたら４０個ありまして、A1:A40に文字列を入れていけば実現できそうですね。考え方がとても参考になりました。ありがとうございました。

回答No.2

Stiltzkin

はじめまして。
おっしゃるようなことは、「条件付き書式」という機能で実現できると思います。Excel2003での操作ですが、範囲H5:O104を選択した状態で、メニューバーの[書式]－[条件付き書式]を選択します。[条件付き書式の設定]ダイアログで、「セルの値が」－「次の値に等しい」を選び、右のボックスに「=$A$1」と入力、あとはセルの書式設定の要領でパターンを赤に設定すれば良いと思います。

お礼

申し訳ありません。言葉足らずでした。Ａ１に記入する文字列を変えたとき、一旦塗りつぶしたセルは塗りつぶしたままにしておきたいので、ＶＢＡかマクロかの方法になるのでしょうか？条件付書式では条件を変えたとき復旧してしまいます。m(_ _)m

回答No.1

noname#65902

対象セルの全てに「条件書式」で、条件を満たす時に赤色で塗りつぶすように設定すればいいです。

Excel2000 の場合ですが
書式(O)→条件付書式(D)
で
[セルの値が][次の値に等しい][=A1]
と入力し、
ボタン[書式]を押して[パターン]で塗りつぶす色を指定します。

お礼

申し訳ありません。言葉足らずでした。Ａ１に記入する文字列を変えたとき、一旦塗りつぶしたセルは塗りつぶしたままにしておきたいので、ＶＢＡかマクロかの方法になるのでしょうか？条件付書式では条件を変えたとき復旧してしまいます。m(_ _)m