Zellwert mit Spalte vergleichen VBA

[diving_excel]

Guten Morgen!

Ich habe eine Frage zum Vergleich von Zelle und Spalte.

In einer Zelle D17 in Tabelle1 steht eine fünfstellige Nummer. Diese soll mit den Werten in Tabelle2 in Spalte A18:A verglichen werden. Wenn ein Match gefunden wird ist alles okay und es muss nichts weiter passieren. Wenn kein Match gefunden wird soll eine Fehlermeldung erscheinen. Dieser Vorgang soll immer dann ausgeführt werden wenn sich der Wert in Zelle I3 in Tabelle3 ändert. Hab dazu auch eine Vorlage von Herrn König gefunden [http://www.innovation-company.de/Blog/Li...aspx?ID=18] und diesen auch etwas angepasst, leider nicht mit Erfolg. Gibt es einen anderen Ansatz?

Hier mein Code bisher:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)


Dim Zeile As Integer
Dim ErrNr As Integer

Zeile = 1
ErrNr = 0

If Target.Address = "$I$3" Then
Do While Cells(Zeile, 1).Value <> ""
   If Worksheets("Tabelle1").Range("D17").Value = Worksheets("Tabelle2").Cells(k, 1).Value And Worksheets("Tabelle3").Range("I3").Value > 2500 Then
   
       ErrNr = ErrNr + 1
   End If
   Zeile = Zeile + 1
Loop

   If ErrNr = 0 Then
       MsgBox "No match between entered ID.", vbCritical, "Error"
       Exit Sub
   End If
End If

End Sub

Was mache ich falsch? Gibt es einen besseren Weg?


Danke für euren Input!
Gruß

[Frogger1986]

Warum benutzt du nicht die worksheetfunction "match"

[diving_excel]

Weil diese Überprüfung erst gestartet werden soll, sobald man eine Eingabe in I3 macht, sich der Wert dort also ändert und dieser dann größer als 2500 ist. Deswegen dachte ich das Change eigentlich ganz sinnvoll wäre, oder liege ich falsch?

[Frogger1986]

Das Change Ereignis ist vollkommen richtig in diesem Fall! Nur deine Funktion im Gesammten scheint mir zu groß! 

"Worksheetfunction Match" oder ".find " ist nahezu gleich der Funktion Vergleich()...

und wird mit dem change Ereignis in deinem fall dann aufgerufen!

Bitte lade eine Beispieldatei hoch die deiner vom Aufbau identisch ist!

[diving_excel]

Hab sie stark abspecken müssen, die betreffenden Zeilen sind aber wie im Original (auch was Position angeht).


  Test ohne Makros.xlsx (Größe: 9,63 KB / Downloads: 2)


  Test mit Makros.xlsm (Größe: 16,17 KB / Downloads: 2)

[Werner.M]

Hallo,

wenn ich dich richtig verstanden habe:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim loLetzte As Long, raBereich As Range

If Target.Address(0, 0) = "D17" Then
   If Worksheets("Wert Eingabe").Range("I3").Value > 2500 Then
       With Worksheets("ID Match Liste")
           loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
           Set raBereich = Worksheets("ID Match Liste").Range("A18:A" & loLetzte)
       End With
       If WorksheetFunction.CountIf(raBereich, Target.Value) > 0 Then
           'nix machen
       Else
           MsgBox "No match between entered ID.", vbCritical, "Error"
       End If
   End If
End If

End Sub

Gruß Werner

[diving_excel]

Hmm nicht ganz, 
dein Code sagt ja aus dass das sub ausgeführt werden soll, sobald sich etwas bei der "ID Eingabe" im Feld "D17" ändert ("sprich Eingabe einer ID") - danach wird gecheckt ob "I3" im "Wert Eingabe" Sheet  größer 2500 ist und erst dann durchläuft dein Code den Check, ob es ein Match bei der "ID Match Liste" gibt. 

Das Problem ist, dass der Wert in "I3" beim öffnen der Datei ja leer ist, d.h. beim Eingeben der ID in "D17" würde als Ergebnis immer "Falsch" raus kommen, da die Wert Eingabe ja erst hinterher erfolgt.

Das Change Ereignis müsste demnach  bei dem "Wert Eingabe" Sheet in "I3" erfolgen. Oder gibt es die Möglichkeit eine 2. Change Funktion innerhalb deines Codes einzubauen?

Nochmal der Arbeitsablauf zum Verständnis:

1. Es wird eine ID im "ID Eingabe" Sheet in D17 eingetragen
   
2. Im "Wert Eingabe" Sheet in I3 wird eine Zahl eingegeben. Wenn diese größer 2500 ist, soll ein check durchgeführt werden, der überprüft, ob die eingegebene ID auch in der "ID Match Liste" vorkommt. Hier stehen die Werte in Spalte A ab Zeile 18 ("A18:A").
   
3. Wenn kein Match gefunden worden ist soll eine Nachricht erscheinen, ansonsten soll nichts passieren.
   

Ich werde mich mal weiter dran setzten und bisschen rumprobieren, danke aber schon mal für den ersten Input.

Gruß

[Werner.M]

Hallo,

Code muss ins Codemodul von Blatt "Wert Eingabe"

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim loLetzte As Long

If Target.Address(0, 0) = "I3" Then
   If IsNumeric(Target.Value) Then
       If Target.Value > 2500 Then
           With Worksheets("ID Match Liste")
               loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
               If WorksheetFunction.CountIf(.Range("A18:A" & loLetzte), Worksheets("ID Eingabe").Range("D17")) > 0 Then
                   'nix machen
               Else
                    MsgBox "No match between entered ID.", vbCritical, "Error"
               End If
           End With
       End If
   End If
End If
End Sub

Gruß Werner

[diving_excel]

Vielen Dank, dass war genau das was ich gesucht habe!

Gruß