VBAで色付きセルを条件にメッセージBOXを出したい。

Question

前提・実現したいこと

B4～D8にA～Cが入力された表があるとします。
表内の１行に２個以上同じ文字が入力されたら赤いセルになるよう、条件書式を入れています。

表に赤いセルが出現したタイミングで「名前が重複しています」というメッセージBOXを表示させたいです。

発生している問題・エラーメッセージ

VBA初心者で、添付写真のように見よう見まねで書いてみたのですが、上手くいきません。
ご教授いただければ幸いです。

該当のソースコード

Sub 重複確認()

    If Range("B4:D8").Interior.Color = RGB(255, 0, 0) Then
    AnswerNo = MsgBox("名前が重複しています", vbCritical)

    End If

End Sub

試したこと

ネットで調べてみてもIF文で値をみて条件を出している記事は見るのですが、
色で条件をだしている記事を見かけなくて困っています。

補足情報（FW/ツールのバージョンなど）

ここにより詳細な情報を記載してください。

Answer 1

こんな感じで、
DisplayFormat プロパティ
を使います。

Sub test()
    Dim c As Range
    
    For Each c In Range("B4:D8")
        If c.DisplayFormat.Interior.Color = vbRed Then
            MsgBox "重複があります。: " & c.Address(False, False)
            Exit Sub
        End If
    Next
End Sub

参考＞＞
条件付き書式で変更された書式を取得する

追記＞＞
セルに入力した時にチェックするなら、色がどうのとか関係ないですよね？

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngEventArea As Range: Set rngEventArea = Me.Range("B4:D8")
    
    If Target.CountLarge > 1 Then Exit Sub
    Set Target = Intersect(Target, rngEventArea)
    If Target Is Nothing Then Exit Sub
    Set rngEventArea = Intersect(Target.EntireRow, rngEventArea)
    
    If WorksheetFunction.CountIf(rngEventArea.Cells, Target.Value) > 1 Then
        MsgBox "既に同じ値を入力済みです。", vbExclamation
        Application.Undo
    End If
End Sub

あぁ、やってみてないけど、同じことがマクロなしでも、入力規則の機能でできるのでは？と思います。
マクロなしで出来るならマクロなしの方が、「元に戻す」がクリアされないので、
そちらの方がより良いかと思います。

Comments

[tyano]

早期にご回答いただき、ありがとうございます！
DisplayFormat プロパティ！また知らない文が出てきてしまいました　笑
VBAの道は長く、険しいですね・・・。

ご提示いただいた文で確かにメッセージBOXを出せました！
が、セルが赤くなったタイミングではなく、赤い状態でマクロを行った条件ででした。
難しいです。。。

[Akashic]

負荷が高くなるのでお勧めはしませんが、VBAのコードを書いている上のところにリストが2つあり、WorkSheet , Change を選ぶと、関数が自動で作られます。(Private Sub Worksheet_Change(ByVal Target As Range))

この中に処理を書けば、マクロ実行時にではなく、ワークシートに変更があったときに実行されます。
https://www.moug.net/tech/exvba/0050131.html

[tyano]

調べてみたら、イベントプロシージャ？という名前らしいですね。
上２つのリストは全然気にもかけていなかったので、勉強になりました！
お忙しいところご回答いただき、ありがとうございます！

[hatena19]

イベントプロシージャを使いこなせるようになるのが、VBA上級者へのステップですね。

Answer 2

既に、回答がついていて、重複する部分もありますが、

表に赤いセルが出現したタイミングで「名前が重複しています」というメッセージBOXを表示させたいです。

「表に赤いセルが出現したタイミング」となると、Worksheet_Change を使うことになりますね。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    Set rng = Intersect(Target, Range("B4:D8"))
    If rng Is Nothing Then Exit Sub
    
    Dim c As Range
    For Each c In rng.Cells
        If c.DisplayFormat.Interior.Color = vbRed Then
            MsgBox "名前が重複しています", vbCritical
            Exit For
        End If
    Next
End Sub

Comments

[tyano]

早期にご回答いただき、ありがとうございます！
試してみたのですが、緑の▶ボタン（ユーザーフォームの実行？）を押しても名前が無く、
マクロを実行することが出来ませんでした・・・。

[tyano]

ユーザーフォームの実行は不要なんですね！
そのままシートのマクロに記入したらいけました！
お忙しいところありがとうございます！

Answer 3

事前に条件書式を入れなくても確認できる方法です。
試してみてください

Sub JufukuKakunin()
    Dim i As Long, j As Long
    For i = 4 To 8
        For j = 2 To 4
            If Application.WorksheetFunction.CountIf(Range(Cells(i, 2), Cells(i, 4)), Cells(i, j)) > 1 Then
                Cells(i, j).Select
                Cells(i, j).Interior.ColorIndex = 3
                MsgBox "重複があります。"
                Exit Sub
            Else
                Cells(i, j).Interior.ColorIndex = 0
            End If
        Next j
    Next i
End Sub

＜別解を追記＞
行単位の重複を調査したい範囲で一度に確認する場合の記載は以下となります。

Sub JufukuKakunin2()
    Dim i As Long, j As Long
    Dim bF As Boolean
    For i = 4 To 8
        For j = 2 To 4
            If Application.WorksheetFunction.CountIf(Range(Cells(i, 2), Cells(i, 4)), Cells(i, j)) > 1 Then
                Cells(i, j).Interior.ColorIndex = 3
                bF = True
            Else
                Cells(i, j).Interior.ColorIndex = 0
            End If
        Next j
    Next i
    If bF Then
        MsgBox "名前が重複している箇所を赤字にしました。"
    End If
End Sub

Comments

[tyano]

早期にご回答いただき、ありがとうございます！
条件書式をVBAで行うことも出来るなんで凄すぎます！

確かに最初の表の状態であれば赤くなりましたが、複数の行で文字が被っている場合は
最初の行のみが赤くなり、２行目以降は白色セルのままになってしまいました。。。

[TanakaHiroaki]

このマクロは、上から１行ずつ左列から右列に確認していき、最初に文字の重複が見つかったセルを赤くして終了するようにしています。
いろんなやり方がありますので、目的に合うよう修正してみてください。

[TanakaHiroaki]

別解を追記しましたので、試してみてください。
条件書式を用いることが必須でなければ、この方法がシンプルに実現できると思います。

[tyano]

別解の追記もありがとうございます！
条件書式、入力規制、VBAと色々な方法があることがわかりました！
まだまだVBAは全然わかりませんが、慣れるように勉強します。
ありがとうございました！

Answer 4

色で判定しなくても、条件付き書式の条件（色を付けている条件）で判定するで良いのではないでしょうか？

Comments

[tyano]

確かに、色がつけばそれはそれでわかるのですが、勉強の一環として、
色でメッセージBOXを出せるのか気になっております。

[Akashic]

なるほど、そういうことですね。

色でメッセージ自体は、記載のコードで判断できています。
メッセージがでないのは、Range("B4:D8")の部分が原因で、Range("B4:D8")だとその部分全て(15セル)が赤じゃないとif条件がTrueになりません。

画像の状態だと、Range("B4:C4")にするとメッセージが出ると思います。

[tyano]

早期にご回答いただき、ありがとうございます！
なるほど！だからメッセージが出なかったんですね！
その中のどれかが、となるとこのIF文では難しいですね・・・。

[hatena19]

セル範囲を絞ったとしても、Interior.Color では条件付き書式で変化した色は取得できません。
DisplayFormat.Interior.Color でないと。
すでに回答に出てますが、念のために。