Vergleich VBA

[herbert0803]

Hallo zusammen,

ich habe eine Exceldatei mit mehreren Tabellenblättern.
Im 1. Tabellenblatt werden in Spalte A ab 2. Zeile Startnummern eingetragen und in Spalte B in der gleichen Zeile eine weitere Nummer = Gruppenzuordnung)
In den weiteren Tabellenblättern werden dann je nach Gruppe die Startnummern wieder eingetragen und dann die Ergebnisse.
Um die Erfassung in einem falschen Tabellenblatt zu verhindern bräuchte ich bei Eingabe der Startnummer in einem Tabellenblatt (A6 bis A200) den Vergleich ob die Gruppe im ersten Tabellenblatt zur Startnummer passt.
Im diesem Tabellenblatt wo die Eingabe erfolgt steht die Gruppe in Zelle W1.
zB Startnummer 1 steht im Tabellenblatt 1 und A2 und die Gruppe unter K2.
Wenn ich im 2. Tabellenblatt die Startnummer im Bereich A6-A200 eintrage soll die Gruppe (Inhalt Zelle Spalte K zu der jeweiligen Zeile wo die Startnummer im ersten Tabellenblatt steht) mit dem Inhalt der Zelle W1 in diesem Tabellenblatt verglichen werden.
Wenn die Inhalte übereinstimmen soll nichts passieren, ansonsten eine Messagebox, dass die Gruppen nicht übereinstimmen.

Ich hoffe ich habe das verständlich erklärt.

Danke!

[Klaus-Dieter]

Hallo Herbert,

so etwas gehört auf ein Tabellenblatt, dann gibt es auch keine Probleme.

[herbert0803]

Hallo Herbert,

so etwas gehört auf ein Tabellenblatt, dann gibt es auch keine Probleme.

Hallo Klaus-Dieter,

das wäre vermutlich besser, aber die Datei ist sehr umfangreich und schon vor längerer Zeit erstellt worden.
Alles umzubauen ist zu aufwendig.
Ich habe selbst noch weiter gesucht und probiert.
Folgender Code funktioniert.
Vielleicht hat noch jemand Verbesserungsvorschläge.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range("A6:A205")
    'Wenn mehr als eine Zelle ausgewählt ist, dann Makro verlassen
    If Target.Count > 1 Then Exit Sub
    'Wenn Zellinhalt gelöscht wird, dann Makro verlassen
    If Target.Value = "" Then Exit Sub

If Not Application.Intersect(KeyCells, Range(Target.Address)) _
    Is Nothing Then

    Dim rngZelle As Range
    Dim strSuchbegriff As String
    strSuchbegriff = Target.Value

    With ActiveWorkbook.Worksheets("Liste")
    ' suche in Spalte A, genaue Übereinstimmung, suche in Werten
    Set rngZelle = .Columns(1).Find(strSuchbegriff, lookat:=xlWhole, LookIn:=xlValues)
    ' Suchbegriff gefunden
        If Not rngZelle Is Nothing Then
            ' Inhalt aus Zelle in gefundener Zeile Spalte K ausgeben und vergleichen mit Inhalt in Zelle W1
            If .Cells(rngZelle.Row, 11).Value = Worksheets("Gruppe 1").Cells(1, 23).Value Then
                'MsgBox "Startnummer stimmt"
            Else
                MsgBox "Bitte die Gruppe überprüfen." & vbCrLf _
                & "Laut Liste gehört die Startnummer " & strSuchbegriff & " in die Gruppe " _
                & .Cells(rngZelle.Row, 11).Value & " !", vbOKOnly + vbCritical, "Hinweis"
       
            End If
        Else
            MsgBox "Bitte die Eingabe überprüfen." & vbCrLf _
            & "Die Startnummer " & strSuchbegriff & " gibt es in der Liste nicht!", _
            vbOKOnly + vbCritical, "Hinweis"
        End If
    End With
End If

End Sub

[HKindler]

Hi,

mal abgesehen davon, dass ich Klaus-Dieter recht gebe und auch die VBA-Routine noch einige Mängel aufweist (z.B. die überflüssige und gefährliche Verwendung von ActiveWorkbook), braucht man hier doch kein VBA. So etwas kann man mit der Datenüberprüfung erschlagen. Verwende dazu die benutzerdefinierte Formel =XVERWEIS(A6;Liste!$A$2:$A$999;Liste!$K$2:$K$999;"";0;1)=$W$1
A6 ist die aktive Zelle der Datenüberprüfung.
Die Bereiche für das Blatt "Liste" auf deine Tabelle anpassen!
Jetzt noch eine entsprechende Fehlermeldung im 3. Reiter der Datenüberprüfung setzen und du hast alles was du brauchst.

Falls dein Excel noch keinen XVerweis kennt, verwendest du einfach den entsprechenden SVerweis
=SVERWEIS(A6;Liste!$A$2:$K$999;11;FALSCH)=$W$1
oder die Kombi Index/Vergleich
=INDEX(Liste!$K$2:$K$999;VERGLEICH(A6;Liste!$A$2:$A$999;0))

[herbert0803]

Hallo Helmut,

es mit Datenüberprüfung zu lösen war schon eine Überlegung, aber ich habe für diese Zellen bereits eine Datenüberprüfung hinterlegt.
Ich bräuchte dann 2 verschiedene Fehlermeldung. Das geht glaube ich nicht, oder?
Zumindest weiß ich jetzt welche Formel ich nehmen müsste, danke.

Dass mein Code nicht einwandfrei ist, habe ich schon angenommen.
Ich bin ein ziemlicher Anfänger, der sich aus verschiedenen Suchergebnissen im Internet ein Makro zusammenbaut.
Funktionieren tut er.
Kannst du mir sagen, was ich in diesem Fall besser machen könnte?

[HKindler]

Hi,

natürlich gibt es nur eine Fehlermeldung pro Datenüberprüfung.
Aber du könntest auch hingehen und gleich nur die richtige Startnummer als Dropdown zulassen.

Dazu musst du dir natürlich erst mal pro Blatt eine Liste der zulässigen Startnummern erstellen. Ob du die auf deinem Blatt "Liste" erstellst oder auf den einzelnen Blättern bleibt dir überlassen. Ich würde es auf den einzelnen Blättern machen. Dazu kommt in z.B. W2 die Formel =FILTER(Liste!A:A;Liste!K:K=W1) Unterhalb dieser Zelle muss natürlich genügend Platz sein. Wenn du willst kannst du sie auch auf z.B. XY1 eingeben.

In die Datenüberpüfung kommt nun unter "Zulassen: Liste" als Quelle die Formel =$W$2# und als Fehlermeldung reicht dann "Unzulässige Startnummer für diese Seite. Bitte korrekte Nummer auswählen."

So. Wenn du dennoch bei VBA bleiben willst, solltest du folgende Regeln / Empfehlungen beachten:

• Tabellenblätter wie z.B. bei
  PHP-Code:

  With ActiveWorkbook.Worksheets("Liste") 

  immer über ihren CodeName z.B.
  PHP-Code:

  With Tabelle1 

  ansprechen. Dann braucht man kein Workbook mit anzugeben, da der CodeName sowieso nur im eigenen Workbook bekannt ist. Außerdem kann man die Blattnamen jederzeit beliebig ändern.
  
• Subs / Functions niemals mit "Exit Sub" / "Exit Function" verlassen
  
• bei Worksheet_Change auch die Verarbeitung von gleichzeitigen Änderungen in mehreren Zellen berücksichtigen. Bei dir könne man z.B. A9:A15 markieren, irgendetwas tippen und Shift-Enter drücken und hätte damit die Kontrolle erfolgreich umschifft.
  
• niemals ActiveXXX verwenden. Wie heißt es so schon bei Forrest Gump: "Das Leben (=ActiveXXX) ist wie eine Schachtel Pralinen, man weiß nie, was man bekommt."
  Insbesondere verwendet man für die Datei, in der der Code steht ThisWorkbook bzw. im Codebereich der Arbeitsmappe Me und im Codebereich eines Tabellenblatts Me.Parent
  

Im Grunde wird dein Code zwar in 99% aller Fälle funktionieren. Aber das ist halt zu wenig.

[herbert0803]

Hallo,

Die vorhandene Datenüberprüfung zielt darauf ab, dass Startnummern nicht doppelt erfasst werden können. Dementsprechend kommt ein passende Fehlermeldung.
Für die zweite Überprüfung soll eine andere Meldung kommen.
Ich hätte gerne dass der Anwender weiß, was er falsch erfasst hat.

Mit meinem Code wäre das möglich. Ich weis ich bin stur.

Ich habe deine Anregungen für den Code bzgl. Tabellenblatt schon angewendet.
Offene Fragen:
Was kann ich anstelle von "Exit Sub" besser verwenden?

Der Code läuft im Tabellenblatt "Gruppe 1".
Nachdem ich den gleichen Code für mehrere Tabellenblätter brauche könnte ich bei 
If .Cells(rngZelle.Row, 11).Value = Worksheets("Gruppe 1").Cells(1, 23).Value Then
das  Worksheets("Gruppe 1"). durch me. ersetzen, damit ich den Code nicht für jedes Tabellenblatt anpassen muss?

Danke!

[DIZA]

Was kann ich anstelle von "Exit Sub" besser verwenden?

 z.B.
anstelle von

Code:

    'Wenn mehr als eine Zelle ausgewählt ist, dann Makro verlassen
    If Target.Count > 1 Then Exit Sub
    'Wenn Zellinhalt gelöscht wird, dann Makro verlassen
    If Target.Value = "" Then Exit Sub

besser das Gegenteil prüfen und dann code ausführen

Code:

   
    If Target.Count < 2 Then

       hier dann dein Code

    End If

[HKindler]

Hi,

für die doppelte Erfassung der Startnummern würde ich auf eine bedingte Formatierung ausweichen, die dann alle gleichen Startnummern z.B. Rot färbt.

Oder du erstellst die Dropdown-Liste mit der Formel
W2: =FILTER(Liste!A:A;Liste!K:K=W1)
X2: =FILTER(W2#;ZÄHLENWENN(A:A;W2#)=0)
W2# ist die Liste mit Startnummern für diese Seite und X2# die Liste ohne die bereits auf dieser Seite vergebenen Startnummern

Oder in einer Formel
W2: =LET(x;FILTER(Liste!A:A;Liste!K:K=W1);FILTER(x;ZÄHLENWENN(A:A;x)=0))

In Ergänzung zu DIZA:
Ich würde auch bei mehr als einer Zelle im Target die Routine abarbeiten. Das macht man dann so:

Code:

Dim Bereich As Range
Dim Zelle As Range
Set Bereich = Intersect(Target, Range("A6:A205"))
If Not Bereich Is Nothing Then
    For Each Zelle In Bereich
        'Hier dein Code mit Zelle statt Target
    Next Zelle
End If

Übrigens: wenn du im Codebereich eines Tabellenblatts einen Range ohne Worksheet angibst, dann bezieht sich er Range immer auf das Tabellenblatt. Statt Worksheets("Gruppe 1").Cells(1, 23).Value kannst du also sowohl Me.Cells(1, 23).Value als aoch Cells(1, 23).Value verwenden.

[juvee]

Hi,

wenn du die Eingabe in alle Tabellen ausser der Tabelle "Liste" überwachen willst, solltest du das Ereignis Workbook_SheetChange() verwenden

das würde ich dann etwa so machen

der Code gehört in den Codebereich von DieseArbeitsmappe

Code:

Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim rg As Range
If Sh.Name <> "Liste" And Not Intersect(Target, Sh.Range("A6:A205")) Is Nothing Then
  If Target.Count > 1 Then
    For Each rg In Target
     Call matchSheet(rg, Sh.Cells(1, 23))
    Next
  Else
    Call matchSheet(Target, Sh.Cells(1, 23))
  End If
End If
End Sub

Sub matchSheet(ByVal rg As Range, mtch As Range)
  Dim retval As Long
  On Error GoTo errorhandler
  retval = WorksheetFunction.VLookup(rg.Value, Worksheets("Liste").Range("A6:K205"), 11, False) <> mtch.Value
  If retval = -1 Then Call createMsg(rg)
  Exit Sub
 
errorhandler:
  Call errMsg(rg)
End Sub

Sub createMsg(rg As Range)
  MsgBox rg.Value & " als Startnummer nicht in Tabelle " & rg.Parent.Name & " zugelassen"
  Call clearCells(rg)
End Sub

Sub errMsg(rg As Range)
  MsgBox "Startnummer nicht in Liste vorhanden/gefunden"
   Call clearCells(rg)
End Sub

Sub clearCells(rg As Range)
  Application.EnableEvents = False
    rg.Value = ""
  Application.EnableEvents = True
End Sub

VG Juvee