[[20220108145957]]　『VBAで特定のセルに複数の特定の文字が一つでも入ａx（shirosuke）　ページの最後に飛ぶ

『VBAで特定のセルに複数の特定の文字が一つでも入っていたらエラー表示を出す』（shirosuke）

よろしくおねがいします。
情報システム部で使用物品のデータ管理しているエクセルファイルを現場でダウンロードしそれを元に現場で作成したカウント用のエクセルファイルにコピー＆ペーストし、物品個数をカウントしています。
しかし使用できない物品が情報システム部では入力され現場では使用できない物品のためカウントができない様になっています。カウントにずれが生じてしまい、どこに使用できない物品が入力されているのかVBAでエラーチェックしメッセージが表示できないか教えていただけたらと思います。

特定のセルは飛び飛びとなっています。特定セル　A1 B1 C1 A3 B3 C3 A5 B5 C5と複数です。特定セル以外は使用できない物品#1or#3or#5は使用可能なためエラー表示は出さなくてもいい。
使用できない物品　♯1or♯3or♯5

   A　　 B 　　C
1 ♯2　♯2    #2　　
2 ♯1  #1     #1
3 #3   #2     #2
4 #1   #1     #1
5 #5   #1     #
6 #3   #3     #3
7 #5   #5     #5

A3に使用できない#3が入っていて、B5,C5に使用できない#1が入っているため"A3、B5、C5に使用できない物品が入っています。確認してください"とメッセージが出るようにしたいです。よろしくおねがいします。

＜使用 Excel：Office365、使用 OS：Windows10 ＞

この内容なら、VBAを使うことはないのでは？
該当セルに条件付き書式を設定し、
条件: #1or#3or#5
書式:赤塗りつぶし
とかにすれば、ユーザーはおかしな入力と気付けると思います。

（もちろん、エラーメッセージにすることもできますが……）
（DS） 2022/01/08(土) 16:35

「特定セル」と「使用できない物品」は、
どのように指定するのでしょうか？
（わからん） 2022/01/08(土) 16:43

 こんな風に色をつかったほうが分かりやすいかも。

 Sub test()
     Dim badWords As Variant
     Dim badW As Variant
     Dim rng As Range
     Dim e As Range
     Dim p As Long
     Dim flag As Boolean

     badWords = Split("#1,#3,#5", ",")         '例
     Set rng = Range("A1:C1,A3:C3,A5:C5")      '例
     rng.Font.ColorIndex = xlAutomatic         'テキストの色を標準に戻す

     For Each e In rng
         If Len(e) > 0 Then
             For Each badW In badWords
                 p = InStr(e.Value, badW)
                 If p > 0 Then
                     e.Characters(Start:=p, Length:=Len(badW)).Font.Color = vbRed
                     flag = True
                 End If
             Next
         End If
     Next
     If flag Then MsgBox "赤の個所の単語は禁止されています"
 End Sub

 #1 が#100 などにマッチしてしまうといった話は、別途あります。
 単なる例示でしょうから、とりあえず無視しておきます。
（γ） 2022/01/08(土) 19:31

皆さんありがとうございます。確かに条件付き書式で行えますね。ありがとうございました。
（shrosuke） 2022/01/08(土) 21:34

条件付き書式を設定し塗りつぶしの設定を行い、おかしなデータは塗りつぶしができるようになりました。

その後印刷作業でのVBAを作成したいと考えています。
塗りつぶしに気づかず印刷を行おうとした場合に、どこのセルに塗りつぶしがあります。確認してください。とメッセージが出て「はい」選択すると印刷はキャンセル、「いいえ」を選択すると「印刷しますか」のメッセージが出て「はい」、「いいえ」を選択し実行できるVBAを作成したいのですが教えていただけたらと思います。塗りつぶしがあったとしても印刷する場合があります。よろしくお願い致します。

対象範囲はB3からS32です。
塗りつぶしの色は赤　パターン種類　6.25%　灰色としています。
（shirosuke） 2022/01/10(月) 17:08

 一例として。
 細かい改良はご自身でお願いします。

 Sub test()
    Dim r As Range
    Dim str() As String
    Dim cnt As Long, buf As Long
    Dim flg As Boolean
    For Each r In Range("B3:S32")
        With r.DisplayFormat.Interior
            If .Color = vbRed And .Pattern = xlGray8 Then
                ReDim Preserve str(cnt)
                str(cnt) = r.Address(False, False)
                cnt = cnt + 1
                flg = True
            End If
        End With
    Next r
    If flg Then
        buf = MsgBox(Join(str, ",") & " に塗りつぶし有り。要確認。" & vbCrLf & "このまま印刷しますか？", vbYesNo)
    Else
        buf = MsgBox("印刷しますか", vbYesNo)
    End If
    If buf = vbYes Then
        ActiveSheet.PrintPreview    'プレビューが不要なら PrintOut
    End If
 End Sub
（参考） 2022/01/10(月) 18:54

返信が遅くなり大変申し訳ありませんでした。ご指導ありがとうございます。
上記のVBAを入力いたしました。あえて条件に合うよう入力し実行したのですが塗りつぶし有り。要確認メッセージがでず、印刷しますか、プレビューとなってしまいます。カラー番号やパターンの定数を調べ間違いがないのですがうまくいきません。よろしくお願いいたします。
（shirusuke） 2022/01/15(土) 16:10

 当方の環境では想定通り動作しているので、お答えしようもありませんが、
 可能性としては、
 ・塗りつぶしたのが対象範囲「B3:S32」外だった。
 ・条件付き書式の設定が「赤色且つパターンの種類が6.25%灰色」では無い。
 とかでしょうか。

 それでもダメなら、新規ワークシートで以下のコードを実行してもらえますか。

 Sub test()
    Dim r As Range
    Dim str() As String
    Dim cnt As Long, buf As Long
    Dim flg As Boolean
'------------------------------
    With Range("B3").Interior
        .Color = vbRed
        .Pattern = xlGray8
    End With
'-------------------------------
    For Each r In Range("B3:S32")
        With r.DisplayFormat.Interior
            If .Color = vbRed And .Pattern = xlGray8 Then
                ReDim Preserve str(cnt)
                str(cnt) = r.Address(False, False)
                cnt = cnt + 1
                flg = True
            End If
        End With
    Next r
    If flg Then
        buf = MsgBox(Join(str, ",") & " に塗りつぶし有り。要確認。" & vbCrLf & "このまま印刷しますか？", vbYesNo + vbExclamation)
    Else
        buf = MsgBox("印刷しますか？", vbYesNo + vbQuestion)
    End If
    If buf = vbYes Then
        ActiveSheet.PrintPreview    'プレビューが不要なら PrintOut
    End If
 End Sub
（参考） 2022/01/15(土) 16:57

新規シートで上記のコードをコピペし実行したところ、私が条件付き書式で設定していた書式と違っていました。
私の条件説明で塗りつぶしと書いていましたが、実際には塗りつぶしなし(背景色なし)、パターンの色が赤、パターン種類が6.25％灰色でした。大変申し訳ありませんでした。
何度も申し訳ありませんがよろしくお願いいたします。
（shrosuke） 2022/01/15(土) 20:30

 条件付き書式が有効になっているセルの上で下記のコードを実行して、
 イミディエイトに表示された値に書き換えればよろしいかと。

 Sub macro()
    With Selection.DisplayFormat.Interior
        Debug.Print "Color:" & .Color
        Debug.Print "Pattern:" & .Pattern
    End With
 End Sub
（参考） 2022/01/15(土) 21:10 ※不要部削除しました。

 下記コードを実行して

 Sub macro()
    With Selection.DisplayFormat.Interior
        Debug.Print "PatternColorIndex:" & .PatternColorIndex
    End With
 End Sub

 以下に書き換え

 If .Pattern = xlGray8 And .PatternColorIndex = 上のコードで表示された数値 Then
（参考） 2022/01/15(土) 21:39

If .Color = 16777215 And .Pattern = xlGray8 Thenに書き換えしたらできました。他のセルでも同様に行いましたが問題なく動作しました。
本当に素晴らしいです。何度も何度も原因追及して頂き、最後までご丁寧にご指導くださり本当にありがとうございました。
（shirosuke） 2022/01/15(土) 21:49

コメント返信：

[ 一覧(最新更新順) ]

[[20220108145957]] 『VBAで特定のセルに複数の特定の文字が一つでも入ａx（shirosuke） ページの最後に飛ぶ

[[20220108145957]]　『VBAで特定のセルに複数の特定の文字が一つでも入ａx（shirosuke）　ページの最後に飛ぶ