[[20130523093422]]　『背景色を指定しセルを検索』（ケビン）　ページの最後に飛ぶ

『背景色を指定しセルを検索』（ケビン）
excel2003

特定の背景色をしたセルをEXCELファイル内の全てのシートで検索したいので
以下の様な処理を作成しましたが　指定した色でないセルでも条件に合致してしまいます。
そこで　ループ処理でなく　検索処理で　セルを検索できないかと思っております。
ご存知の方　ご教授下さい。

  For Each sh In Worksheets
    If sh.Name <> "Control_LIST" Then
        '４０列　７０行
            For i = 1 To 40
                For ii = 1 To 70
'                    If Cells(ii, i).Interior.Color = RGB(255, 235, 251) Then 'RGB(255, 235, 251)=16509951
                    If Cells(ii, i).Interior.Color = 16509951 Then 'RGB(255, 235, 251)=16509951
                       If Cells(ii, i).Value = "" Then
                            MsgBox "「" + sh.Name + "」シートに未入力があります。確認下さい"
'                             Exit Sub
                        End If
                    End If
                Next
            Next
      End If
    Next

 Excel2003では、塗り潰しのパレット（セルの書式→パターンで出てくる56色）に存在しない色をセルに指定した場合、
 自動的に最も近い色に変換されるようです。
 MsgBox RGB(255, 235, 251) は確かに16509951を返しますが、以下のコードでは変換された色(白色)の数値を返します。
 Sub sample()
     Range("A1").Interior.Color = RGB(255, 235, 251)
     MsgBox Range("A1").Interior.Color
 End Sub

 解決策じゃなくてすいませんが、セルに出力された時点で全てパレット上の白と判断されてしまうので、
 セル情報を元に検索するのは難しいと思います。
 その色塗りをされる条件を見直したほうが良いのでは？
(Jera)

指定色以外はそれに近い色での判断は知りませんでした。
有難うございます。
セル情報での検索は　以下のところまでできたのですが　やはり色の問題なのか
検索条件にヒットしません。

    Application.FindFormat.Clear
    Application.FindFormat.Interior.Color = 16509951
    Set FoundCell = sh.Cells.Find(What:="*", SearchFormat:=True)

        If FoundCell Is Nothing Then
            MsgBox "見つかりません"
'            Exit Sub
        Else
            Set FirstCell = FoundCell

                If FoundCell.Value = "" Then
                    MsgBox "「" + sh.Name + "」シートに未入力があります。確認下さい"
                    Exit Sub

                End If

        Do
            Set FoundCell = sh.Cells.FindNext(FoundCell)
            If FoundCell.Address = FirstCell.Address Then
                Exit Do
            Else
                If FoundCell.Value = "" Then
                    MsgBox "「" + sh.Name + "」シートに未入力があります。確認下さい"
                    Exit Do

                End If

            End If
        Loop
    End If
（ケビン）

 Jera さんの懸念はありますが、もしセルが指定した色であるとすると、最初の例が
 うまくいかないのはセルの指定がシート指定になっていないからではないでしょうか。
 下記でやっても同じ状況でしょうか。
 (Mook)

 Sub Sample()
    Dim sh As Worksheet
    Dim r As Range
    Dim res As String
    For Each sh In Worksheets
        If sh.Name <> "Control_LIST" Then
            For Each r In sh.Range("A1").Resize(70, 40)
                If r.Interior.Color = 16509951 And r.Value = "" Then
                    If res <> "" Then res = res & ","
                    res = res & sh.Name
                    Exit For
                End If
            Next
        End If
    Next

    If res = "" Then
        MsgBox "記入漏れはありません。"
    Else
        MsgBox "「" & res & "」シートに未入力があります。確認下さい"
    End If
 End Sub

コメント返信：

[ 一覧(最新更新順) ]

[[20130523093422]] 『背景色を指定しセルを検索』（ケビン） ページの最後に飛ぶ

[[20130523093422]]　『背景色を指定しセルを検索』（ケビン）　ページの最後に飛ぶ