Live-Forum - Die aktuellen Beiträge
Datum
Titel
26.04.2024 12:46:38
Nutzereingaben Speichern und Laden
26.04.2024 11:49:48
VAB und Bedingte Formatierung nimmt die Farbe im Makro nicht
26.04.2024 11:38:46
Acrobat PDF Formularfelder mit Excel ausfüllen
26.04.2024 11:23:04
zählen wenn - aber nur die selektierten Zeilen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1340to1344
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1340to1344
1340to1344
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Listbox in Tabellenblatt mit Prüfung ob schon vorh

Listbox in Tabellenblatt mit Prüfung ob schon vorh
15.12.2013 15:05:42
Werner
Stehe mal wieder auf dem Schlauch,
mit folgendem Code schreibe ich Daten aus einer 3-spaltigen Listbox in die Tabellenblätter "Personalien" und "Dummy".
Jetzt bräuchte ich noch eine Prüfung, ob der Familienname, der Vorname und das Geburtsdatum (j, 0 / j, 1 / j, 2 der Listbox) im Tabellenblatt "Personalien" schon vorhanden sind (Familienname in D5:D100, Vorname in E5:E100, Geburtsdatum in F5:F100).
Wenn ja, dann soll nichts in die Tabellenblätter geschrieben werden sondern eine Messagebox auf den Umstand hinweisen und das Makro beendet werden.
Private Sub Anlegen_Click()
Dim j As Integer
Application.ScreenUpdating = False
If Personalien.ListIndex = -1 Then
MsgBox "Bitte in der Liste eine Auswahl treffen.", 48, "  Hinweis für " & Application. _
UserName
TextBox1.SetFocus
Exit Sub
End If
If Von = "" Then
MsgBox "Bitte ein gültiges Datum eingeben.", 48, "  Hinweis für " & Application.UserName
Von.SetFocus
Exit Sub
End If
With Von
.SelStart = 0
.SelLength = Len(.Text)
End With
Von.SetFocus
Exit Sub
End If
If Bis = "" Then
MsgBox "Bitte ein gültiges Datum eingeben.", 48, "  Hinweis für " & Application.UserName
Bis.SetFocus
Exit Sub
End If
With Bis
.SelStart = 0
.SelLength = Len(.Text)
End With
Bis.SetFocus
Exit Sub
End If
Worksheets("Daten").Unprotect Password:="*****"
Worksheets("Dummy").Unprotect Password:="*****"
Worksheets("Personalien").Unprotect Password:="*****"
With Personalien
For j = 0 To .ListCount - 1
If .Selected(j) Then
Sheets("Personalien").Cells(Rows.Count, 4).End(xlUp).Offset(1) = .List(j, 0)
Sheets("Personalien").Cells(Rows.Count, 5).End(xlUp).Offset(1) = .List(j, 1)
Sheets("Personalien").Cells(Rows.Count, 6).End(xlUp).Offset(1) = .List(j, 2)
Sheets("Personalien").Cells(Rows.Count, 4).End(xlUp).Offset(, 3) = "anwesend"
Sheets("Personalien").Cells(Rows.Count, 4).End(xlUp).Offset(, 4) = CDate(Von)
Sheets("Personalien").Cells(Rows.Count, 4).End(xlUp).Offset(, 5) = CDate(Bis)
Sheets("Dummy").Cells(Rows.Count, 4).End(xlUp).Offset(1) = .List(j, 0)
Sheets("Dummy").Cells(Rows.Count, 5).End(xlUp).Offset(1) = .List(j, 1)
Sheets("Dummy").Cells(Rows.Count, 6).End(xlUp).Offset(1) = .List(j, 2)
Sheets("Dummy").Cells(Rows.Count, 4).End(xlUp).Offset(, 4) = CDate(Von)
Sheets("Dummy").Cells(Rows.Count, 4).End(xlUp).Offset(, 5) = CDate(Bis)
Personalien.RemoveItem (j)
End If
Next
End With
Worksheets("Dateneingabe").Activate
Worksheets("Personalien").Protect Password:="*****"
Worksheets("Jahrestabelle").Protect Password:="*****"
Worksheets("Dummy").Protect Password:="*****"
Aufenthaltsverbot.Von = ""
Aufenthaltsverbot.Bis = ""
Unload Me
Application.ScreenUpdating = True
End Sub
Wahrscheinlich nicht sehr schwierig (wenn man weiß wie es geht). Ich kriege es leider nicht hin.
Gruß Werner

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Listbox in Tabellenblatt mit Prüfung ob schon vorh
15.12.2013 18:31:43
Beverly
Hi Werner,
ohne deine Mappe zu kennen ist das nicht so einfach. Versuche es mal auf diesem Weg (kann ich ja leider nicht testen):
  Dim lngZaehler As Long
Dim lngLetzte As Long
Dim lngZeile As Long
With Worksheets("Personalien")
lngLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 4)), _
.Cells(.Rows.Count, 4).End(xlUp).Row, .Rows.Count)
End With
With Personalien
For j = 0 To .ListCount - 1
If .Selected(j) Then
For lngZeile = 1 To lngLetzte
If Sheets("Personalien").Cells(lngZeile, 4) = .List(j, 0) And _
Sheets("Personalien").Cells(lngZeile, 5) = .List(j, 1) _
And Sheets("Personalien").Cells(lngZeile, 6) = .List(j, 2) Then
MsgBox "Name bereits eingetragen"
Exit For
Else
Sheets("Personalien").Cells(Rows.Count, 4).End(xlUp).Offset(1) = .List(j, 0)
Sheets("Personalien").Cells(Rows.Count, 5).End(xlUp).Offset(1) = .List(j, 1)
Sheets("Personalien").Cells(Rows.Count, 6).End(xlUp).Offset(1) = .List(j, 2)
Sheets("Personalien").Cells(Rows.Count, 4).End(xlUp).Offset(, 3) = "anwesend"
Sheets("Personalien").Cells(Rows.Count, 4).End(xlUp).Offset(, 4) = CDate(Von)
Sheets("Personalien").Cells(Rows.Count, 4).End(xlUp).Offset(, 5) = CDate(Bis)
Sheets("Dummy").Cells(Rows.Count, 4).End(xlUp).Offset(1) = .List(j, 0)
Sheets("Dummy").Cells(Rows.Count, 5).End(xlUp).Offset(1) = .List(j, 1)
Sheets("Dummy").Cells(Rows.Count, 6).End(xlUp).Offset(1) = .List(j, 2)
Sheets("Dummy").Cells(Rows.Count, 4).End(xlUp).Offset(, 4) = CDate(Von)
Sheets("Dummy").Cells(Rows.Count, 4).End(xlUp).Offset(, 5) = CDate(Bis)
Personalien.RemoveItem (j)
End If
Next lngZeile
End If
Next
End With
End Sub

Anzeige
AW: Funktioniert nicht
16.12.2013 19:05:33
Werner
Hallo Karin,
danke für deine Antwort. Mit deinem Code funktioniert es leider nicht. Ich habe deinen Code mit zwei Änderungen bei mir eingebaut.
Änderung 1: Die Zeile For lngZeile = 1 To lngLetzte habe ich in For lngZeile = 4 To lngLetzte geändert, da in meiner Tabelle "Personalien" ab Zeile 5 die Daten eingetragen werden sollen. In Zeile 4 stehen die Überschriften dazu.
Änderung 2: Die Zeile Personalien.RemoveItem (j) habe ich auskommentiert. Da hat er mir immer mal wieder (für mich aber nicht nachvollziehbar) Laufzeitfehler (Index ist ungültig) für diesen Bereich angezeigt: If Sheets("Personalien").Cells(lngZeile, 4) = .List(j, 0) And _
Sheets("Personalien").Cells(lngZeile, 5) = .List(j, 1) _
And Sheets("Personalien").Cells(lngZeile, 6) = .List(j, 2) Then
So habe ich deinen Code jetzt in meiner Userform:
Dim j As Integer
Dim lngZaehler As Long
Dim lngLetzte As Long
Dim lngZeile As Long
Application.ScreenUpdating = False
Worksheets("Personalien").Unprotect Password:="*****"
Worksheets("Dummy").Unprotect Password:="*****"
With Worksheets("Personalien")
lngLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 4)), _
.Cells(.Rows.Count, 4).End(xlUp).Row, .Rows.Count)
End With
With Personalien
For j = 0 To .ListCount - 1
If .Selected(j) Then
For lngZeile = 4 To lngLetzte
If Sheets("Personalien").Cells(lngZeile, 4) = .List(j, 0) And _
Sheets("Personalien").Cells(lngZeile, 5) = .List(j, 1) _
And Sheets("Personalien").Cells(lngZeile, 6) = .List(j, 2) Then
MsgBox "Bereits vorhanden"
Exit For
Else
Sheets("Personalien").Cells(Rows.Count, 4).End(xlUp).Offset(1) = .List(j, 0)
Sheets("Personalien").Cells(Rows.Count, 5).End(xlUp).Offset(1) = .List(j, 1)
Sheets("Personalien").Cells(Rows.Count, 6).End(xlUp).Offset(1) = .List(j, 2)
Sheets("Personalien").Cells(Rows.Count, 4).End(xlUp).Offset(, 3) = "Aufenthaltsverbot"
Sheets("Personalien").Cells(Rows.Count, 4).End(xlUp).Offset(, 4) = CDate(Von)
Sheets("Personalien").Cells(Rows.Count, 4).End(xlUp).Offset(, 5) = CDate(Bis)
Sheets("Dummy").Cells(Rows.Count, 4).End(xlUp).Offset(1) = .List(j, 0)
Sheets("Dummy").Cells(Rows.Count, 5).End(xlUp).Offset(1) = .List(j, 1)
Sheets("Dummy").Cells(Rows.Count, 6).End(xlUp).Offset(1) = .List(j, 2)
Sheets("Dummy").Cells(Rows.Count, 4).End(xlUp).Offset(, 4) = CDate(Von)
Sheets("Dummy").Cells(Rows.Count, 4).End(xlUp).Offset(, 5) = CDate(Bis)
'Personalien.RemoveItem (j)
End If
Next lngZeile
End If
Next
End With
Worksheets("Personalien").Protect Password:="*****"
Worksheets("Dummy").Protect Password:="*****"
Application.ScreenUpdating = True
Jetzt passiert folgendes: Lege ich die erste Person an, sprich die Tabelle "Personalien" ist bis auf die Überschriften leer, dann geht das problemlos. Sobald ich eine weitere Person anlege trägt er mir diese 2 mal in die Tabellen ein, die nächste Person 4 mal, die nächste Person 8 mal und so weiter.
Versuche ich eine Person, die in der Tabelle "Person" bereits vorhanden ist, erneut anzulegen, dann bringt er mit zwar die Message-Box, die Person wird aber dennoch angelegt (hier jetzt nur 1 mal).
Ich komm nicht weiter. Vielleicht kannst du mir ja weiter helfen.
Gruß Werner

Anzeige
AW: Funktioniert nicht
16.12.2013 19:09:06
Beverly
Hi Werner,
dazu hatte ich mich schon in meinem vorhergehenden Beitrag geäußert - wie soll man etwas nachvollziehen können, wenn man die Mappe nicht kennt?

AW: Funktioniert nicht
17.12.2013 14:32:48
Beverly
Hi Werner,
vielleicht solltest du mal genau beschreiben was zu machen ist.

Anzeige
AW: Funktioniert nicht
17.12.2013 19:55:03
Werner
Hi Karin,
es sollte geprüft werden ob der Name der Vorname und das Geburtsdatum das in der Listbox gewählt wurde in der Tabelle Personal schon vorhanden ist. Wenn ja Messagebox und nichts in die Tabellen schreiben.
Werner

AW: Funktioniert nicht
17.12.2013 20:44:22
Beverly
Hi Werner,
das ist schon klar, aber es wäre gut, wenn du mal an einem konkreten Beispiel das schrittweise Vorgehen erläuterst.

AW: Funktioniert nicht
18.12.2013 10:01:37
Werner
Hi Karin,
das Ganze soll so ablaufen. Ich befinde mich auf dem Tabellenblatt "Dateneingabe" klicke auf die Schaltfläche anlegen, die Userform öffnet sich, in der Listbox der Userform sind die Datensätze aus dem Tabellenblatt "Jahrestabelle" eingelesen. Ich wähle in der Listbox einen Datensatz aus und trage in den Textboxen von und bis ein Datum ein. Dann klicke ich auf anlegen. Jetzt soll er prüfen, ob der Name, der Vorname und das Geburtsdatum des ausgewählten Datensatzes der Listbox in der Tabelle Person bereits vorhanden ist. Wenn ja soll er mit eine entsprechende Nachricht ausgeben und nichts in die Tabellenblätter "Person" und "Dummy" schreiben, wenn nein soll er die Daten des in der Listbox ausgewählten Datensatzes in die Tabellenblätter "Person" und "Dummy" schreiben.
Gruß Werner

Anzeige
AW: Funktioniert nicht
18.12.2013 10:59:49
Beverly
Hi Werner,
so sollte es jetzt funktionieren:
  Dim lngZaehler As Long
Dim lngLetzte As Long
Dim lngZeile As Long
Dim blnVorhanden As Boolean
With Worksheets("Personen")
lngLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 4)), _
.Cells(.Rows.Count, 4).End(xlUp).Row, .Rows.Count)
End With
With Personalien
For j = 0 To .ListCount - 1
If .Selected(j) Then
For lngZeile = 1 To lngLetzte
If Sheets("Personen").Cells(lngZeile, 4) = .List(j, 0) And _
Sheets("Personen").Cells(lngZeile, 5) = .List(j, 1) _
And Sheets("Personen").Cells(lngZeile, 6) = .List(j, 2) Then
MsgBox "Name bereits eingetragen"
blnVorhanden = True
Exit For
End If
Next lngZeile
If blnVorhanden = False Then
Sheets("Personen").Cells(Rows.Count, 4).End(xlUp).Offset(1) = .List(j, 0)
Sheets("Personen").Cells(Rows.Count, 5).End(xlUp).Offset(1) = .List(j, 1)
Sheets("Personen").Cells(Rows.Count, 6).End(xlUp).Offset(1) = .List(j, 2)
Sheets("Personen").Cells(Rows.Count, 4).End(xlUp).Offset(, 3) = "anwesend"
Sheets("Personen").Cells(Rows.Count, 4).End(xlUp).Offset(, 4) = CDate(Von)
Sheets("Personen").Cells(Rows.Count, 4).End(xlUp).Offset(, 5) = CDate(Bis)
Sheets("Dummy").Cells(Rows.Count, 4).End(xlUp).Offset(1) = .List(j, 0)
Sheets("Dummy").Cells(Rows.Count, 5).End(xlUp).Offset(1) = .List(j, 1)
Sheets("Dummy").Cells(Rows.Count, 6).End(xlUp).Offset(1) = .List(j, 2)
Sheets("Dummy").Cells(Rows.Count, 4).End(xlUp).Offset(, 4) = CDate(Von)
Sheets("Dummy").Cells(Rows.Count, 4).End(xlUp).Offset(, 5) = CDate(Bis)
Personalien.RemoveItem (j)
End If
blnVorhanden = False
End If
Next
End With

Anzeige
AW: Funktioniert bestens
18.12.2013 11:37:38
Werner
Hallo Karin,
danke für deine Geduld. Dein Code funktioniert wunderbar.
Danke Werner

Links zu Excel-Dialogen

UserForm MessageBox

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige