[Excel] Alter und neuer Datensatz gleichzeitig

josef24

Erfahrenes Mitglied
Guten Tag in die Runde. Ich möchte einen Programmschritt automatisieren und damit Fehler bei der Eingabe vermeiden.
Ich will eine Vereinfachung bei der Dateneingabe erreichen, stoße dabei aber auf Probleme. Gebe mittels USERFORM einen Datensatz ein, und möchte erreichen, das dieser sobald ich den nächsten Datensatz eingebe, abgespeichert wird. Wenn ich das getrennt vornehme erscheint mir der neue Datensatz wie ich es gewohnt war. Bei der Verbindung über "Call cmdSave_Click" werden unkontrollierte ständig neue Datensätze bereit gestellt, die aber wie bisher in der USERFORM nicht sichtbar sind. Wenn es überhaupt möglich ist , könnte mich vielleicht jemand beim Code schreiben unterstützen. Danke und Gruß Josef

Code:
Sub cmdNew_Click()
Dim lZeile As Long
lZeile = 1
     Do While Trim(CStr(wsAt.Cells(lZeile, 1).Value)) <> ""
         lZeile = lZeile + 1
     Loop
wsAt.Cells(lZeile, 1) = CStr("NR " & lZeile)
wsAt.Cells(lZeile, 2) = CStr("NeuMtgld ")

lstData.AddItem
lstData.List(lstData.ListCount - 1, 1) = CStr("NR " & lZeile)
lstData.ListIndex = lstData.ListCount - 1

  Call cmdSave_Click
End Sub

Private Sub cmdSave_Click() '  Daten übertragen , Datei – Speichern [aktive Arbeitsmappe]
    Dim lZeile As Long
    Dim rngRow As Range
    If lstData.ListIndex = -1 Then Exit Sub
    If Trim(CStr(txtPosNr.Text)) = "" Then
    MsgBox "Sie müssen mindestens eine Nummer eingeben!", vbCritical + vbOKOnly, "FEHLER!"
        Exit Sub
    End If
    'Zeile suchen und auslesen
    If seekArb(txtPosNr, rngRow) Then    'Werte übernehmen
         rngRow.Cells(, colAtPosNr).Value = Trim(CStr(txtPosNr.Text))
        rngRow.Cells(, colAtNummer).Value = txtnummer.Text
        rngRow.Cells(, colAtAnrede).Value = txtAnrede.Text
'  usw. usw..........
 
Wo hast du den Aufruf Call cmdSave_Click ?
Und Wie geht die Funktion cmdSave_Click() weiter?
 
Hier weitere Erklärungen und der ges. Code meines Versuchs. Der Code wird über die USERFORM1 aufgerufen. Im ersten Sub ist der Code Call cmd... vorhanden.Danke und Gruß Josef

Code:
Sub cmdNew_Click() '  CommandButton1

Dim lZeile As Long
lZeile = 1
     Do While Trim(CStr(wsAt.Cells(lZeile, 1).Value)) <> ""
         lZeile = lZeile + 1
     Loop
wsAt.Cells(lZeile, 1) = CStr("NR " & lZeile)
wsAt.Cells(lZeile, 2) = CStr("NeuMtgld ")

lstData.AddItem
lstData.List(lstData.ListCount - 1, 1) = CStr("NR " & lZeile)
lstData.ListIndex = lstData.ListCount - 1

  Call cmdSave_Click
End Sub

Private Sub cmdSave_Click() '  Daten übertragen , Datei – Speichern [aktive Arbeitsmappe]
    Dim lZeile As Long
    Dim rngRow As Range
    If lstData.ListIndex = -1 Then Exit Sub
    If Trim(CStr(txtPosNr.Text)) = "" Then
    MsgBox "Sie müssen mindestens eine Nummer eingeben!", vbCritical + vbOKOnly, "FEHLER!"
        Exit Sub
    End If
    'Zeile suchen und auslesen
    If seekArb(txtPosNr, rngRow) Then    'Werte übernehmen
         rngRow.Cells(, colAtPosNr).Value = Trim(CStr(txtPosNr.Text))
        rngRow.Cells(, colAtNummer).Value = txtnummer.Text
        rngRow.Cells(, colAtAnrede).Value = txtAnrede.Text
        rngRow.Cells(, colAtNachname).Value = txtNachname.Text
        rngRow.Cells(, colAtVorname).Value = txtVorname.Text
        rngRow.Cells(, colAtStrasse).Value = txtStrasse.Text
        rngRow.Cells(, colAtWohnort).Value = txtWohnort.Text
        rngRow.Cells(, colAtTelefon).Value = txtTelefon.Text
        If IsDate(txtGeburtstag.Text) Then rngRow.Cells(, colAtGeburtstag).Value = CDate(txtGeburtstag.Text)   'Datumsfeld mit Format
        If IsDate(txtEintritt.Text) Then rngRow.Cells(, colAtEintritt).Value = CDate(txtEintritt.Text)   'Datumsfeld mit Format
        If IsDate(txtAustritt.Text) Then rngRow.Cells(, colAtAustritt).Value = CDate(txtAustritt.Text)   'Datumsfeld mit Format
        If IsDate(txtgenBis.Text) Then rngRow.Cells(, colAtgenBis).Value = CDate(txtgenBis.Text)   'Datumsfeld mit Format
        rngRow.Cells(, colAtGruppe).Value = txtgruppe.Text
        rngRow.Cells(, colAtKrankenkasse).Value = txtkrankenkasse.Text
        rngRow.Cells(, colAtKrKNr).Value = txtKrKNr.Text
        rngRow.Cells(, colAtBemerkung).Value = TxTBemerkung.Text
        rngRow.Cells(, colAtZahlung).Value = TxTZahlung.Text

        'User Formular neu laden
        Call UserForm_Initialize
    Else
        MsgBox "Nummer " & txtPosNr.Text & " nicht gefunden", vbExclamation + vbOKOnly
    End If
'              Call Sichern
    End Sub
 
Danke erst mal. Musste noch einen Arzttermin wahrnehmen, daher erst jetzt die Antwort.
Hier die Userform_Initialze() aus meiner Codefolge. Gruß Josef

Code:
Private Sub UserForm_Initialize()  ' Zeilen löschen
   Dim lZeile As Long
 
    clearForm
    
    With Tabelle4
        lstData.List = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp).Offset(0, 7)).Value
    End With
    
End Sub
 
Ich sehe grad kein Fehler. Kannst du eine Testdatei mit dem Code und ein oder zwei Testzeilen hochladen?
Dann kann man das mal debuggen.
 
Danke, hänge hier die Datei mal an. Gruß Josef
 

Anhänge

  • Test_3tes Quatal 2018.zip
    800,2 KB · Aufrufe: 2
Da fällt mir gerade auf.
Im cmdNew_Click() sollte cmdSave_Click() ganz am Anfang durchgeführt werden. Erst dann den neuen anlegen.
 
Danke, habe die Reihenfolge der beiden Code gedreht, das war doch gemeint von dir? Das funktioniert soweit ganz gut. Etwas unschön ist, das er jedes mal einen neuen Datensatz erstellt, was man aber nicht immer will.
Kann man das irgendwie unterbinden? Gruß Josef
 
Aber das wolltest du doch?
cmdNew_Click() speichert den bestehenden Code und erstellt einen neuen.
Man kann es unterbinden. Aber wie soll die Logik aussehen?
 
Zurück