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!
Hallo Herbert,
so etwas gehört auf ein Tabellenblatt, dann gibt es auch keine Probleme.
(29.08.2023, 11:26)Klaus-Dieter schrieb: [ -> ]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
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))
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?
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")
- 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.
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!
(30.08.2023, 11:13)herbert0803 schrieb: [ -> ]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
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.
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