[[20120402151929]]　『一致したセルの背景色を変えるにはどうしたらいい』（me）　ページの最後に飛ぶ

『一致したセルの背景色を変えるにはどうしたらいいですか？』（me）

エクセル２００３のVBAについて質問です。
複数の検索したい文字列があり、複数の検索対象セルがあります。
セルの文字列が検索文字列のいずれかと一致したセルの背景の色を変えたいです。
よろしくおねがいします。

仕事でマクロを組まなけばならなくなってしまったのですが、
初心者のため検索してみたり調べてみたり、参考にして作ってみたのですがうまくいかないばかりかどんどん解らなくなってしまいました。
どうか助けてください。

sheet1のセルが検索対象
（全セル対象でも大丈夫ですが、検索したいセルはB2→J2、B11→J11、B20→J20の範囲です）、
sheet2のA列に検索したい文字列が入力されています。
この検索したい文字列は今後増えていく可能性があるので、増えた場合にも対応できるようにと考えています。

sheet1（検索対象）
あいうえあおお

sheet2（検索文字列）
あ
う
お
け
き

↑の様に入力されており、sheet1の「あ」と「う」と「お」のセルの背景を変えたいです。
色を変えたいのはsheet1です。

findメソッドや繰り返し処理などを調べて実践してみたのですが、
いきなりマクロを組めといわれた超初心者には難しく質問しています。
自分でやってみたのですが、
sheet1の最初の「あ」のみが変換され、後に出てくる「あ」が変換されません…
どうしたらいいのか…どうすることも出来ず困っております。
すみませんが、どなたか優しい方助けてください。
よろしくおねがいします＞＜

 たぶん、すぐに　Find/FindNext による回答が出ると思うので、天邪鬼な案を。
（Find/FindNextは重いので、あまり好きじゃなくって）

 Sub Sample()
    Dim myR As Range
    Dim sh2 As Worksheet
    Dim Target As Range
    Dim c As Range

    Application.ScreenUpdating = False

    Set sh2 = Sheets("Sheet2")

    Set myR = Sheets("Sheet1").Range("B2:J2,B11:J11,B20:J20")
    myR.Replace What:="", Replacement:=vbTab, LookAt:=xlWhole
    myR.Interior.ColorIndex = xlNone

    For Each c In sh2.Range("A1", sh2.Range("A" & sh2.Rows.Count).End(xlUp))
        Set Target = Nothing
        On Error Resume Next
        myR.Replace What:=c.Value, Replacement:="", LookAt:=xlWhole
        Set Target = myR.SpecialCells(xlCellTypeBlanks)
        On Error GoTo 0
        If Not Target Is Nothing Then
            Target.Interior.Color = vbYellow
            Target.Replace What:="", Replacement:=c.Value, LookAt:=xlWhole
        End If
    Next

    myR.Replace What:=vbTab, Replacement:="", LookAt:=xlWhole

    Set sh2 = Nothing
    Set myR = Nothing
    Set Target = Nothing

    Application.ScreenUpdating = True

    MsgBox "色付け完了"

 End Sub

 (ぶらっと)

ありがとうございます。
さっそくやってみました。
変更されず…

sheet1のセルには数式が入力されているのですが、それが原因でしょうか…？

 条件付書式では駄目なのでしょうか？

 ＞この検索したい文字列は今後増えていく可能性があるので、増えた場合にも対応できるようにと考えています。 
 って事なので、名前の定義をする部分はマクロ
 ついでに条件を設定する部分もマクロにして
 「マクロですよ」って言う手も。。。

 その後の運用方法が分からないので
 どうしてもセルの色（Interior.ColorIndex）を変更しておく必要が有るのかもしれませんが。

 (HANA)

 >sheet1のセルには数式が入力されているのですが

 ひぁぁ！！　はい、それが原因。そうなると、きらいでもFind/FindNextのほうが簡単かもしれないけど
 乗りかかった舟なので、後ほど↑のコードの構成で改訂版をアップするね。

 でも、対象領域が狭いので、HANAさんの回答のように、条件付書式がいいかもね。

 (ぶらっと)

 意地の（？）改訂版
 (そのアップした改訂版を、こそっと改訂）

 Sub Sample2()
    Dim sh2 As Worksheet
    Dim Target As Range
    Dim c As Range
    Dim sv As Variant
    Dim myR As Range

    Application.ScreenUpdating = False

    Set sh2 = Sheets("Sheet2")
    Set myR = Sheets("Sheet1").Range("B2:J20")

    sv = myR.Formula
    myR.Replace What:="", Replacement:=vbTab, LookAt:=xlWhole
    myR.Value = myR.Value
    myR.Interior.ColorIndex = xlNone

    For Each c In sh2.Range("A1", sh2.Range("A" & sh2.Rows.Count).End(xlUp))
        myR.Replace What:=c.Value, Replacement:="", LookAt:=xlWhole
    Next

    On Error Resume Next
    Set Target = myR.Cells.SpecialCells(xlCellTypeBlanks)
    On Error GoTo 0
    If Not Target Is Nothing Then Target.Interior.Color = vbYellow

    myR.Formula = sv

    Set sh2 = Nothing
    Set myR = Nothing
    Set Target = Nothing

    Application.ScreenUpdating = True

    MsgBox "色付け完了"

 End Sub

 (ぶらっと)

ぶらっとさんへ
ありがとうございました！
できました！

自分ひとりじゃ到底できませんでした。
ほんほうにありがとうございました！

コピペするだけではなく、ちゃんと理解して使いたいと思います＾＾
自分で頑張って解読してみます！

もう１ついいでしょうか？

このマクロをｼｰﾄをアクティブにした時に実行するようにしたいのですが、
可能でしょうか？

なんども申し訳ないです。

 もし、マクロをこれから勉強していく、その手始めに、Find を調べてがんばっているということなら
 Findを使う場合は、こんなふうにというサンプル。

 Sub Sample3()
    Dim sh2 As Worksheet
    Dim c As Range
    Dim r As Range
    Dim f As Range
    Dim myR As Range

    Application.ScreenUpdating = False

    Set sh2 = Sheets("Sheet2")
    Set myR = Sheets("Sheet1").Range("B2:J2,B11:J11,B20:J20")

    myR.Interior.ColorIndex = xlNone

    For Each c In sh2.Range("A1", sh2.Range("A" & sh2.Rows.Count).End(xlUp))
        Set r = myR.Find(What:=c.Value, LookIn:=xlValues, LookAt:=xlWhole)
        If Not r Is Nothing Then
            Set f = r
            Do
                r.Interior.Color = vbYellow
                Set r = myR.FindNext(r)
            Loop While r.Address <> f.Address
        End If
    Next

    Set sh2 = Nothing
    Set myR = Nothing
    Set r = Nothing
    Set f = Nothing

    Application.ScreenUpdating = True

    MsgBox "色付け完了"

 End Sub

 (ぶらっと)

こちらの方が理解しやすそうなので、こっちのほうから解読していきます！
ほんとにありがとうございます。

 >このマクロをｼｰﾄをアクティブにした時に実行するようにしたいのですが

 それではSheet1のシートモジュールに（シートタブを右クリックしてコードの表示を選ぶとでてくる）
 最初にブックを開いた時に、Sheet1がアクティブでも実行しない。どこか別のシートで作業して
 Sheet1に戻った時に実行。もし、ブックを開いた時にも実行したければ、ちょっと手を加える。

 コピペするコードは、Sample2でもSample3でも、お好きなものを。

 Private Sub Worksheet_Activate()
    'ここに、先頭の Sub と 最後の End SUbをのぞいたコードをコピペ。
 End Sub

 (ぶらっと)

subが重複していたんですね。
解決しました！
ありがとうございます！
なにからなにまでお世話になりました！

VBAが少し面白く感じました。

コメント返信：

[ 一覧(最新更新順) ]

[[20120402151929]] 『一致したセルの背景色を変えるにはどうしたらいい』（me） ページの最後に飛ぶ

[[20120402151929]]　『一致したセルの背景色を変えるにはどうしたらいい』（me）　ページの最後に飛ぶ