Supportnet / Forum / Tabellenkalkulation

Hallo, ich habe mir von Oliver`s HP folgenden Code geladen, nun habe ich folgendes Problem mit dem Code, bei den Code wird nach dem Nachnamen und dann nach Vorname gesucht, ich müßte aber nach PLZ und dann nach Ort suchen und ich finde nicht die stelle wo ich das ändern muß und bei mir müßte die suche auch nicht in der Zeile zwei sondern ab der Zeile drei anfangen. Die drei zusätzlichen Spalten konnte ich noch einfügen aber mit dem anderen Problem komme ich nicht weiter ,ich hoffe es kann mir jemand helfen. Gruß Achim

nach folgend der Codein zwei teile.
Teil 1

Private Sub Daten_übernehmen_Click()
Dim Zeile As Long
´Schleife und Abfrage zum Prüfen ob Datensatz in Tabellenblatt bereits vorhanden
For Wiederholungen_Eintrag = 2 To Range("B65536").End(xlUp).Row
If Nachname.Text = Cells(Wiederholungen_Eintrag, 2) _
And Vorname.Text = Cells(Wiederholungen_Eintrag, 1) Then
Eintrag_vorhanden = 1
Zeile_Eintrag = Wiederholungen_Eintrag
End If
Next
´Wenn Eintrag bereits vorhanden, die Daten in der entsprechenden Zeile abändern
If Eintrag_vorhanden = 1 Then
Sheets("Eingabe, Suchen und Ändern 2").Cells(Zeile_Eintrag, 1) = Vorname
Sheets("Eingabe, Suchen und Ändern 2").Cells(Zeile_Eintrag, 2) = Nachname
Sheets("Eingabe, Suchen und Ändern 2").Cells(Zeile_Eintrag, 3) = Strasse
Sheets("Eingabe, Suchen und Ändern 2").Cells(Zeile_Eintrag, 4) = Nummer
Sheets("Eingabe, Suchen und Ändern 2").Cells(Zeile_Eintrag, 5) = Postleitzahl
Sheets("Eingabe, Suchen und Ändern 2").Cells(Zeile_Eintrag, 6) = Ort
Sheets("Eingabe, Suchen und Ändern 2").Cells(Zeile_Eintrag, 7) = Geburtsdatum
Sheets("Eingabe, Suchen und Ändern 2").Cells(Zeile_Eintrag, 8) = Bemerkungen
Sheets("Eingabe, Suchen und Ändern 2").Cells(Zeile_Eintrag, 9) = test1
Sheets("Eingabe, Suchen und Ändern 2").Cells(Zeile_Eintrag, 10) = test2
Sheets("Eingabe, Suchen und Ändern 2").Cells(Zeile_Eintrag, 11) = test3
SendKeys "{TAB}"
SendKeys "{TAB}"
´ansonsten Daten in erste leere Zeile eintragen
Else
Zeile_Blatt_2 = Sheets("Eingabe, Suchen und Ändern 2").Range("A65536").End(xlUp).Offset(1, 0).Row
Sheets("Eingabe, Suchen und Ändern 2").Cells(Zeile_Blatt_2, 1) = Vorname
Sheets("Eingabe, Suchen und Ändern 2").Cells(Zeile_Blatt_2, 2) = Nachname
Sheets("Eingabe, Suchen und Ändern 2").Cells(Zeile_Blatt_2, 3) = Strasse
Sheets("Eingabe, Suchen und Ändern 2").Cells(Zeile_Blatt_2, 4) = Nummer
Sheets("Eingabe, Suchen und Ändern 2").Cells(Zeile_Blatt_2, 5) = Postleitzahl
Sheets("Eingabe, Suchen und Ändern 2").Cells(Zeile_Blatt_2, 6) = Ort
Sheets("Eingabe, Suchen und Ändern 2").Cells(Zeile_Blatt_2, 7) = Geburtsdatum
Sheets("Eingabe, Suchen und Ändern 2").Cells(Zeile_Blatt_2, 8) = Bemerkungen
Sheets("Eingabe, Suchen und Ändern 2").Cells(Zeile_Blatt_2, 9) = test1
Sheets("Eingabe, Suchen und Ändern 2").Cells(Zeile_Blatt_2, 10) = test2
Sheets("Eingabe, Suchen und Ändern 2").Cells(Zeile_Blatt_2, 11) = test3
SendKeys "{TAB}"
SendKeys "{TAB}"
End If
´Kombinationsfelder "Vorname" und "Nachname" leeren
Nachname.Clear
Vorname.Clear
´Schleife und Abfrage zum erneuten Füllen der ComboBox "Nachname"
For Wiederholungen = 2 To Range("A65536").End(xlUp).Row
If WorksheetFunction.CountIf(Range("B2:B" & Wiederholungen), _
Cells(Wiederholungen, 2)) = 1 Then _

zweiter Teil:

Nachname.AddItem Cells(Wiederholungen, 2)
Next
End Sub
Private Sub Eingabe_beenden_Click()
Unload Me
End Sub
Private Sub Nachname_Change()
Vorname.Clear
´Schleife und If Abfrage zum Finden von passenden Vornamen zu dem ausgewähleten Nachnamen
For Wiederholungen = 2 To Range("B65536").End(xlUp).Row
If Nachname.Text = Cells(Wiederholungen, 2) Then
´gefundene Vornamen in Spalte IV auflisten
Cells(Range("IV65536").End(xlUp).Offset(1, 0).Row, 256) = Cells(Wiederholungen, 1)
End If
Next
´Schleife und If Abfrage zum Füllen der ComboBox "Vorname"
For Wiederholungen = 2 To Range("IV65536").End(xlUp).Row
Vorname.AddItem (Cells(Wiederholungen, 256))
Next
´Aufgelistete Vornamen löschen
Range("IV:IV").ClearContents
End Sub
Private Sub UserForm_Initialize()
MsgBox "Bitte zuerst den Nachnamen und danach den Vornahmen wählen, damit Datensätze angezeigt werden können."
´Schleife zum Füllen der ComboBox "Nachname" ohne Duplikate
For Wiederholungen = 2 To Range("A65536").End(xlUp).Row
If WorksheetFunction.CountIf(Range("B2:B" & Wiederholungen), _
Cells(Wiederholungen, 2)) = 1 Then _
Nachname.AddItem Cells(Wiederholungen, 2)
Next
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
´Fehlermeldung, wenn versucht wird, die UserForm über das rote
´Schließenkreuz oben rechts zu schließen
If CloseMode = 0 Then
Cancel = 1
MsgBox "Bitte verlassen Sie das Dialogfeld mit den Schaltflächen.", _
vbOKOnly + vbInformation, "Bitte Schaltfläche betätigen."
End If
End Sub
Private Sub Vorname_Change()
´Schleife und If Abfrage zum Füllen der restlichen Textfelder
For Wiederholungen_Vorname = 2 To Range("B65536").End(xlUp).Row
If Nachname.Text = Cells(Wiederholungen_Vorname, 2) _
And Vorname.Text = Cells(Wiederholungen_Vorname, 1) Then
Strasse = Cells(Wiederholungen_Vorname, 3)
Nummer = Cells(Wiederholungen_Vorname, 4)
Postleitzahl = Cells(Wiederholungen_Vorname, 5)
Ort = Cells(Wiederholungen_Vorname, 6)
End If
Next
For Wiederholungen_Vorname = 2 To Sheets("Eingabe, Suchen und Ändern 2").Range("B65536").End(xlUp).Row
If Nachname.Text = Sheets("Eingabe, Suchen und Ändern 2").Cells(Wiederholungen_Vorname, 2) _
And Vorname.Text = Sheets("Eingabe, Suchen und Ändern 2").Cells(Wiederholungen_Vorname, 1) Then
Geburtsdatum = Sheets("Eingabe, Suchen und Ändern 2").Cells(Wiederholungen_Vorname, 7)
Bemerkungen = Sheets("Eingabe, Suchen und Ändern 2").Cells(Wiederholungen_Vorname, 8)
test1 = Sheets("Eingabe, Suchen und Ändern 2").Cells(Wiederholungen_Vorname, 9)
test2 = Sheets("Eingabe, Suchen und Ändern 2").Cells(Wiederholungen_Vorname, 10)
test3 = Sheets("Eingabe, Suchen und Ändern 2").Cells(Wiederholungen_Vorname, 11)
End If
Next
End Sub


Grüße Achim

Hallo Achim,

so ganz weiß ich jetzt noch nicht, was Du mit



meinst. Geht es Dir nur beim Datenübernehmen darum oder auch beim Befüllen der Boxen in der UserForm?

Für das Problem, dass bei Dir die Daten erst ab Zeile 3 beginnen, suche in dem gesamten VBA Code die Zeilen, in der ein Befehl mit For beginnt. ändere hinter dem Gleichheitszeichen (=) die Zahl 2 in eine 3 um und es werden Dir die Daten erst ab Zeile 3 angezeigt.

Ich hoffe Dir erst mal weitergeholfen zu haben. Für die nicht beantwortetet Frage müsstest Du noch die erforderliche Antwort posten.

MfG,
Oliver
_{Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein}
^{Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.}

Hallo Oliver,

erst mal Danke für deine Hilfe, ich finde es wirklich super was Du ( Ihr ) da macht.

Aber nun zu meinen Problem.
Bei deinem Beispiel muß man ja erst den Nachnamen und dann den Vornamen angeben um die dazugehörigen Daten zu Suchen.
Bei mir müßte das ganze aber erst nach PLZ und dann Ort geschehen.
Es geht so mit nur um die Suche von Daten, wenn man Daten dazufügen will ist ja die Reihenfolge egal.
Ich hoffe so mit deine Frage beantwortet zu haben.

Ich lerne immer mehr dazu so langsam komme ich auch dahinter.


Gruß und noch einen schönen Abend
Achim

Moin Micha,

tausche den nachfolgenden Code gegen den in der Beispieldatei aus.

Private Sub Daten_übernehmen_Click()
Dim Zeile As Long
´Schleife und Abfrage zum Prüfen ob Datensatz in Tabellenblatt bereits vorhanden
For Wiederholungen_Eintrag = 2 To Range("B65536").End(xlUp).Row

If Nachname.Text = Cells(Wiederholungen_Eintrag, 6) _
And Vorname.Text = Cells(Wiederholungen_Eintrag, 5) Then

Eintrag_vorhanden = 1
Zeile_Eintrag = Wiederholungen_Eintrag
End If
Next

´Wenn Eintrag bereits vorhanden, die Daten in der entsprechenden Zeile abändern
If Eintrag_vorhanden = 1 Then
Sheets("Eingabe, Suchen und Ändern").Cells(Zeile_Eintrag, 1) = Vorname
Sheets("Eingabe, Suchen und Ändern").Cells(Zeile_Eintrag, 2) = Nachname
Sheets("Eingabe, Suchen und Ändern").Cells(Zeile_Eintrag, 3) = Strasse
Sheets("Eingabe, Suchen und Ändern").Cells(Zeile_Eintrag, 4) = Nummer
Sheets("Eingabe, Suchen und Ändern").Cells(Zeile_Eintrag, 5) = Postleitzahl
Sheets("Eingabe, Suchen und Ändern").Cells(Zeile_Eintrag, 6) = Ort

Sheets("Eingabe, Suchen und Ändern 2").Cells(Zeile_Eintrag, 1) = Vorname
Sheets("Eingabe, Suchen und Ändern 2").Cells(Zeile_Eintrag, 2) = Nachname
Sheets("Eingabe, Suchen und Ändern 2").Cells(Zeile_Eintrag, 3) = Strasse
Sheets("Eingabe, Suchen und Ändern 2").Cells(Zeile_Eintrag, 4) = Nummer
Sheets("Eingabe, Suchen und Ändern 2").Cells(Zeile_Eintrag, 5) = Postleitzahl
Sheets("Eingabe, Suchen und Ändern 2").Cells(Zeile_Eintrag, 6) = Ort

Sheets("Eingabe, Suchen und Ändern 2").Cells(Zeile_Eintrag, 7) = Geburtsdatum
Sheets("Eingabe, Suchen und Ändern 2").Cells(Zeile_Eintrag, 8) = Bemerkungen
SendKeys "{TAB}"
SendKeys "{TAB}"



´ansonsten Daten in erste leere Zeile eintragen
Else
Zeile_Blatt_1 = Sheets("Eingabe, Suchen und Ändern").Range("A65536").End(xlUp).Offset(1, 0).Row
Zeile_Blatt_2 = Sheets("Eingabe, Suchen und Ändern 2").Range("A65536").End(xlUp).Offset(1, 0).Row
Sheets("Eingabe, Suchen und Ändern").Cells(Zeile_Blatt_1, 1) = Vorname
Sheets("Eingabe, Suchen und Ändern").Cells(Zeile_Blatt_1, 2) = Nachname
Sheets("Eingabe, Suchen und Ändern").Cells(Zeile_Blatt_1, 3) = Strasse
Sheets("Eingabe, Suchen und Ändern").Cells(Zeile_Blatt_1, 4) = Nummer
Sheets("Eingabe, Suchen und Ändern").Cells(Zeile_Blatt_1, 5) = Postleitzahl
Sheets("Eingabe, Suchen und Ändern").Cells(Zeile_Blatt_1, 6) = Ort

Sheets("Eingabe, Suchen und Ändern 2").Cells(Zeile_Blatt_2, 1) = Vorname
Sheets("Eingabe, Suchen und Ändern 2").Cells(Zeile_Blatt_2, 2) = Nachname
Sheets("Eingabe, Suchen und Ändern 2").Cells(Zeile_Blatt_2, 3) = Strasse
Sheets("Eingabe, Suchen und Ändern 2").Cells(Zeile_Blatt_2, 4) = Nummer
Sheets("Eingabe, Suchen und Ändern 2").Cells(Zeile_Blatt_2, 5) = Postleitzahl
Sheets("Eingabe, Suchen und Ändern 2").Cells(Zeile_Blatt_2, 6) = Ort

Sheets("Eingabe, Suchen und Ändern 2").Cells(Zeile_Blatt_2, 7) = Geburtsdatum
Sheets("Eingabe, Suchen und Ändern 2").Cells(Zeile_Blatt_2, 8) = Bemerkungen
SendKeys "{TAB}"
SendKeys "{TAB}"
End If

´Kombinationsfelder "Vorname" und "Nachname" leeren
Nachname.Clear
Vorname.Clear
´Schleife und Abfrage zum erneuten Füllen der ComboBox "Nachname"
For Wiederholungen = 3 To Range("A65536").End(xlUp).Row
If WorksheetFunction.CountIf(Range("B2:B" & Wiederholungen), _
Cells(Wiederholungen, 6)) = 1 Then _
Nachname.AddItem Cells(Wiederholungen, 6)
Next

End Sub

Private Sub Eingabe_beenden_Click()
Unload Me
End Sub

Private Sub Nachname_Change()

Vorname.Clear

´Schleife und If Abfrage zum Finden von passenden Vornamen zu dem ausgewähleten Nachnamen
For Wiederholungen = 2 To Range("B65536").End(xlUp).Row
If Nachname.Text = Cells(Wiederholungen, 5) Then
´gefundene Vornamen in Spalte IV auflisten
Cells(Range("IV65536").End(xlUp).Offset(1, 0).Row, 256) = Cells(Wiederholungen, 6)
End If
Next

´Schleife und If Abfrage zum Füllen der ComboBox "Vorname"
For Wiederholungen = 2 To Range("IV65536").End(xlUp).Row
Vorname.AddItem (Cells(Wiederholungen, 256))
Next

´Aufgelistete Vornamen löschen
Range("IV:IV").ClearContents

End Sub

Aufgrund der Länge des VBA Codes und die damit in diesem Forum vorhandenen Begrenzung, folgt der zweite Teil in der nächsten Antwort.

Ab hier geht’s weiter.

Private Sub UserForm_Initialize()
MsgBox "Bitte zuerst eine Postleitzahl und danach den Ort wählen, damit Datensätze angezeigt werden können."
´Schleife zum Füllen der ComboBox "Nachname" ohne Duplikate
For Wiederholungen = 3 To Range("A65536").End(xlUp).Row
If WorksheetFunction.CountIf(Range("E2:E" & Wiederholungen), _
Cells(Wiederholungen, 5)) = 1 Then _
Nachname.AddItem Cells(Wiederholungen, 5)
Next
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
´Fehlermeldung, wenn versucht wird, die UserForm über das rote
´Schließenkreuz oben rechts zu schließen
If CloseMode = 0 Then
    Cancel = 1
    MsgBox "Bitte verlassen Sie das Dialogfeld mit den Schaltflächen.", _
        vbOKOnly + vbInformation, "Bitte Schaltfläche betätigen."
End If

End Sub


Private Sub Vorname_Change()

´Schleife und If Abfrage zum Füllen der restlichen Textfelder
For Wiederholungen_Vorname = 3 To Range("B65536").End(xlUp).Row

If Nachname.Text = Cells(Wiederholungen_Vorname, 5) _
And Vorname.Text = Cells(Wiederholungen_Vorname, 6) Then


Strasse = Cells(Wiederholungen_Vorname, 3)
Nummer = Cells(Wiederholungen_Vorname, 4)
Postleitzahl = Cells(Wiederholungen_Vorname, 1)
Ort = Cells(Wiederholungen_Vorname, 2)
End If
Next

For Wiederholungen_Vorname = 3 To Sheets("Eingabe, Suchen und Ändern 2").Range("B65536").End(xlUp).Row
If Nachname.Text = Sheets("Eingabe, Suchen und Ändern 2").Cells(Wiederholungen_Vorname, 5) _
And Vorname.Text = Sheets("Eingabe, Suchen und Ändern 2").Cells(Wiederholungen_Vorname, 6) Then

Geburtsdatum = Sheets("Eingabe, Suchen und Ändern 2").Cells(Wiederholungen_Vorname, 7)
Bemerkungen = Sheets("Eingabe, Suchen und Ändern 2").Cells(Wiederholungen_Vorname, 8)
End If
Next

End Sub

Mit dem Code werden Dir die beiden ComboBoxen je nach Auswahl mit PLZ und Ort gefüllt.

Ich hoffe, Du kommst klar. Bei Fragen melde Dich bitte

MfG,
Oliver
_{Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein}
^{Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.}

Hallo Oliver,

vielen Dank für deine Hilfe den Code den du mir geben hast funktionierte so weit ganz gut, ich mußte aber noch ein paar Änderungen machen da immer eine Fehlermeldung kam. Den Fehler habe ich aber nun doch selber gefunden, da ich ja wie gesagt dazu lernen möchte und nur durch solche Fehler lernt man dazu.
Also noch einmal vielen, vielen Dank, wenn ich nicht mehr weiter komme werd ich mich mit Sicherheit wieder melden.


Gruß
Achim

Hallo,

ich bin es wieder, ich habe leider noch ein kleines Problem mit dem oben genanten Code er funktioniert super, nur wenn ich die Daten über die EingabeBox eingebe und dann sortieren will ( Name , PlZ )funktioniert das ganze nicht, erst wenn ich die PLZ per Hand eingebe also in der Tabelle die Daten ändere und nicht über die EingabeBox. ( Die Spalte ist als Zahl formatiert )
Ich hoffe ich habe mich so einigermaßen deutlich ausgedrückt was ich meinte.



Gruß
Achim

Zitat:
^{Admininfo: bitte vermeide Mehrfachanfragen in verschiedenen, bzw. gleichen Gruppen. Siehe FAQ 2.}

• Zeichenkettenaddition bei VBA?
• VBA Code eingeben/ wie ?
• VBA - Problem mit Listbox
• VBA-Editor öffnen und schließen