Office: (Office 2013) MsgBox bei zwei Werten

Hallo Zusammen,

wenn ich im Bereich E2029:E200000 in eine Zelle Test1 eingebe kommt die MsgBox ohne Probleme.
Wie muss man den Code ändern damit die Box auch kommt wenn ich Test2 eingebe?

Code:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Intersect(Target, Range("E2029:E20000")) = "Test1" Then
MsgBox (" Bitte prüfen !")
Exit Sub
End If
End Sub

 

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Intersect(Target, Range("E2029:E20000")) = "Test1" OR "Test2" Then
MsgBox (" Bitte prüfen !")
Exit Sub
End If
End Sub

 

Hi,

@EbyAS: hast du das getestet?

Wenn schon dann so:

Code:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Intersect(Target, Range("E2029:E20000")) = "Test1" OR _
   Intersect(Target, Range("E2029:E20000")) = "Test2" Then
    MsgBox (" Bitte prüfen !")
Exit Sub
End If
End Sub

Aber das ist ziemlich fehleranfällig. Daher besser:

Code:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim Bereich As Range
Dim Zelle As Range
Set Bereich = Intersect(Target, Range("E2029:E20000"))
If Not Bereich Is Nothing Then
    For Each Zelle in Bereich
        Select Case UCase(Zelle)
            Case "TEST1", "TEST2"
                Zelle.Select
                MsgBox "Zelle " & Zelle.Address & " bitte Prüfen"
        End Select
    Next Zelle
End If
End Sub

Aber auch das ist noch weit davon entfernt perfekt zu sein.

@merkurmedium Wenn du tatsächlich nur auf "Test1" und "Test2" prüfen willst, dann könntest du auch

Code:

If Intersect(Target, Range("E2029:E20000")) Like "Test#" Then

in Betracht ziehen. Allerdings ist dieser Code dann auch alles andere als stabil und steigt z.B. aus wenn du die Zellen E2030 und E2031 markierst und die Entf-Taste drückst.

 

Hallo,

danke für Eure Hilfe.
Habe mich für Armin seine Variante entschieden.

 

Hallo,
am Ende hat dann doch nur dieser Code funktioniert.Weil bei dem anderen Code bei Einträgen in den Zellen in Spalte F eine Fehlermeldung ausgegeben wurde.
Also danke Helmut.

Code:

Code:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim Bereich As Range
Dim Zelle As Range
Set Bereich = Intersect(Target, Range("E2029:E20000"))
If Not Bereich Is Nothing Then
    For Each Zelle in Bereich
        Select Case UCase(Zelle)
            Case "TEST1", "TEST2"
                Zelle.Select
                MsgBox "Zelle " & Zelle.Address & " bitte Prüfen"
        End Select
    Next Zelle
End If
End Sub