Hilfe bei Userform für Dateneingabe

[M.Wichmann]

Hallo,


ich habe eine Tabelle zur Erfassung von Leergutbewegungen die ich mit einer Userform befülle.
Diese funktioniert auch soweit gut, aber jetzt, nach einer weile Praktischer Arbeit habe ich ein Verbesserungspotential erkannt.

Momentan kann ich neue Einträge mit leeren Feldern erzeugen und vorhandene Einträge bearbeiten.

Da ich aber auch zb. mehrere gleiche Verpackungen am selben Tag, bzw auch auf einem Lieferschein mehrere Verpackungsarten habe, wäre es sehr von Vorteil die Möglichkeit zu haben, einen Vorhandenen Eintrag auszuwählen, die Daten anzupassen und das dann in die nächste leere Zeile einzutragen. Anstatt das er alle Felder in der UF leert.

Leider bekomme ich diese UF(die ich modifiziert auch für andere sachen einsetze) zwar etwas angepasst, aber um das Umzusetzen benötige ich doch Unterstützung.

Hier mal der Code der momentanen UF:

Code:

Option Explicit
Option Compare Text

Dim IDZeile&

Private Sub cbArt_Change()

End Sub

Private Sub cbKunde_Change()
AktualisiereArt
End Sub

Sub AktualisiereArt()
'nur eindeutige Werte
Dim lz&, var
   Dim myDic As Object
   Set myDic = CreateObject("scripting.Dictionary")
 
   With ThisWorkbook.Worksheets("Datenerfassung")
       lz = .ListObjects(2).DataBodyRange.Rows.Count + 1
       For Each var In .Range("M3:M" & lz)
           If var.Offset(0, -1) = cbKunde.Value Then myDic(var.Value) = 0
       Next
   cbArt.Clear
   cbArt.List = myDic.keys
   cbArt.Value = .Cells(IDZeile, 4)
   End With
Set myDic = Nothing
End Sub

Sub AktualisiereKunden()
'nur eindeutige Werte
Dim lz&, var
   Dim myDic As Object
   Set myDic = CreateObject("scripting.Dictionary")
 
   With ThisWorkbook.Worksheets("Datenerfassung")
       lz = .ListObjects(2).DataBodyRange.Rows.Count + 1
       For Each var In .Range("L3:L" & lz)
            myDic(var.Value) = 0
       Next
   cbKunde.Clear
   cbKunde.List = myDic.keys
   cbKunde.Value = .Cells(IDZeile, 3)
   End With
Set myDic = Nothing
End Sub
'

'Neuer Eintrag Schaltfläche Ereignisroutine
Private Sub CommandButton1_Click()
  Dim lZeile As Long
  Dim loLetzte As Long
 
  'Wenn der Benutzer einen neuen Eintrag erzeugen möchte,
  'erstellen wir einen neuen Eintrag in der ListBox und markieren
  'diesen, damit der Benutzer die Daten eintragen kann
 
  loLetzte = Tabelle1.Cells(Rows.Count, 1).End(xlUp).Row           ' letzte belegte in Spalte A (1)
  lZeile = loLetzte + 1
  'Nun steht lZeile in der ersten leeren Zeile von Tabelle1
  'Neuen Eintrag in die Tabelle1 schreiben, Spalte ID muss gefüllt sein, damit
  'unsere Routinen die Zeile wiederfinden!
  Tabelle1.Cells(lZeile, 1) = " " & lZeile
 
  'Und neuen Eintrag in die UserForm eintragen
  ListBox1.AddItem Tabelle1.Cells(lZeile, 1)
 
  'Den neuen Eintrag markieren mit Hilfe des ListIndexes
  ListBox1.ListIndex = ListBox1.ListCount - 1
  'Durch das Click Ereignis der ListBox werden die Daten automatisch geladen
 
End Sub

'Löschen Schaltfläche Ereignisroutine
Private Sub CommandButton2_Click()
  Dim lZeile As Long
  Dim loLetzte As Long
 
  'Wenn kein Datensatz in der ListBox markiert wurde, wird die Routine beendet
  If ListBox1.ListIndex = -1 Then Exit Sub
 
  loLetzte = Tabelle1.Cells(Rows.Count, 1).End(xlUp).Row           ' letzte belegte in Spalte A (1)
 
  'Zum Löschen benötigen wir die Zeilennummer des ausgewählten Datensatzes
  loLetzte = Tabelle1.Cells(Rows.Count, 1).End(xlUp).Row           ' letzte belegte in Spalte A (1)
  'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht
  For lZeile = 2 To loLetzte          'Do While Trim(CStr(Tabelle1.Cells(lZeile, 1).Value)) <> ""
     
     'Datensatz ID Spalte mit selektiertem Eintrag der ListBox vergleichen
     If ListBox1.Text = Tabelle1.Cells(lZeile, 1).Value Then
       
        'Eintrag gefunden, die ganze Zeile wird nun gelöscht
        Tabelle1.Rows(CStr(lZeile & ":" & lZeile)).Delete
       
        'Die ListBox muss nun neu geladen werden!
        Call UserForm_Initialize
        If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
       
        Exit Sub 'Vorzeitiges Ende, da der Datensatz schon gefunden ist
     End If
  Next lZeile   'Loop
 
End Sub

'Speichern Schaltfläche Ereignisroutine
Private Sub CommandButton3_Click()
  Dim lZeile As Long
  Dim loLetzte As Long
 
  'Wenn kein Datensatz in der ListBox markiert wurde, wird die Routine beendet
  If ListBox1.ListIndex = -1 Then Exit Sub
 
  loLetzte = Tabelle1.Cells(Rows.Count, 1).End(xlUp).Row           ' letzte belegte in Spalte A (1)
 
  'Wir müssen prüfen, ob die ID Spalte auch gefüllt ist!!
  If TextBox1.Text = "" Then
     'Meldung ausgeben
     MsgBox "Sie müssen mindestens eine ID eingeben!", vbCritical + vbOKOnly, "FEHLER!"
     'Abbrechen der Speicherroutine
     Exit Sub
  End If
  'Ausbauoption: Prüfen, ob die ID in Tabelle1 Spalte 1 schon vorhanden ist!
 
  'Zum Speichern benötigen wir die Zeilennummer des ausgewählten Datensatzes
  lZeile = 2 'Start in Zeile 2, Zeile 1 sind ja die Überschriften
  'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht
  For lZeile = 2 To loLetzte
     
     'Datensatz ID Spalte mit selektiertem Eintrag der ListBox vergleichen
     If ListBox1.Text = Tabelle1.Cells(lZeile, 1).Value Then
       
        'Eintrag gefunden, TextBoxen in die Zellen schreiben
        Tabelle1.Cells(lZeile, 8).Value = TextBox1.Text
        Tabelle1.Cells(lZeile, 3).Value = TextBox2.Text
        Tabelle1.Cells(lZeile, 4).Value = cbArt.Text
        Tabelle1.Cells(lZeile, 5).Value = TextBox4.Text
        Tabelle1.Cells(lZeile, 6).Value = TextBox5.Text
        Tabelle1.Cells(lZeile, 1).Value = TextBox6.Text
        Tabelle1.Cells(lZeile, 7).Value = TextBox7.Text
        Tabelle1.Cells(lZeile, 3).Value = cbKunde.Text
       
        'Die ListBox muss nun neu geladen werden
        'allerdings nur, wenn sich der Name (ID) geändert hat
       
'Was ist denn das für ein Quatsch? Du vergleichst die ID mit einem Datum? Murks!
'         If ListBox1.Text <> TextBox1.Text Then
'            Call UserForm_Initialize
'            If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
'         End If
        Call sortieren
        Exit Sub 'Vorzeitiges Ende, da der Datensatz schon gefunden ist
       
     End If
     
  Next lZeile
  'Call sortieren
End Sub

'Beenden Schaltfläche Ereignisroutine
Private Sub CommandButton4_Click()
  Unload Me
 
End Sub

Private Sub Image1_Click()

End Sub

'Klick auf die ListBox Ereignisroutine
Private Sub ListBox1_Click()
  Dim lZeile As Long
  Dim loLetzte As Long
 
  'Wenn der Benutzer einen Namen anklickt, suchen wir
  'diesen in der Tabelle1 heraus und tragen die Daten
  'in die TextBoxen ein.
 
  loLetzte = Tabelle1.Cells(Rows.Count, 1).End(xlUp).Row           ' letzte belegte in Spalte A (1)
 
  'Wir löschen standardmäßig alle bisherigen TextBoxen-Inhalte
  TextBox1 = ""
  TextBox2 = ""
'   ComboBox2 = ""
  TextBox4 = ""
  TextBox5 = ""
  TextBox6 = ""
  TextBox7 = ""
'   ComboBox1 = ""
 
  'Nur wenn ein Eintrag selektiert/markiert ist
  If ListBox1.ListIndex >= 0 Then
     
     lZeile = 2 'Start in Zeile 2, Zeile 1 sind ja die Überschriften
     'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht
     For lZeile = 2 To loLetzte
       
        'Wenn wir den Namen aus der ListBox1 in der Tabelle1 Spalte 1
        'gefunden haben, übertragen wir die anderen Spalteninhalte
        'in die TextBoxen!
        If ListBox1.Text = Tabelle1.Cells(lZeile, 1).Value Then
           
           'TextBoxen füllen
           TextBox1 = Tabelle1.Cells(lZeile, 8).Value
           TextBox2 = Tabelle1.Cells(lZeile, 3).Value
'            ComboBox2 = Tabelle1.Cells(lZeile, 4).Value
           TextBox4 = Tabelle1.Cells(lZeile, 5).Value
           TextBox5 = Tabelle1.Cells(lZeile, 6).Value
           TextBox6 = Tabelle1.Cells(lZeile, 1).Value
           TextBox7 = Tabelle1.Cells(lZeile, 7).Value
'            ComboBox1 = Tabelle1.Cells(lZeile, 3).Value
           IDZeile = lZeile
           AktualisiereKunden

           Exit Sub 'Vorzeitiges Ende, da der Datensatz schon gefunden ist
        End If
     Next lZeile
  End If
End Sub

'Private Sub UserForm_Activate()
'   'Wenn die Eingabemaske angezeigt wird, markieren wir den ersten Namen
'   'jedoch nur, wenn auch Einträge in der Liste stehen
'   If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
'End Sub

'Startroutine, wird ausgeführt bevor die Eingabemaske angezeigt wird
Private Sub UserForm_Initialize()
  Dim lZeile As Long
  Dim loLetzte As Long
 
  loLetzte = Tabelle1.Cells(Rows.Count, 1).End(xlUp).Row           ' letzte belegte in Spalte A (1)
 
  'Alle TextBoxen leer machen
  TextBox1 = ""
  TextBox2 = ""
'   ComboBox2 = ""
  TextBox4 = ""
  TextBox5 = ""
  TextBox6 = ""
  TextBox7 = ""
'   ComboBox1 = ""
  'In dieser Routine laden wir alle vorhandenen
  'Einträge in die ListBox1
  ListBox1.Clear 'Zuerst einmal die Liste leeren
 
  'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht
  For lZeile = 2 To loLetzte          'Do While Trim(CStr(Tabelle1.Cells(lZeile, 1).Value)) <> ""
     'Aktuelle Zeile in die ListBox eintragen
     ListBox1.AddItem Tabelle1.Cells(lZeile, 1).Value
  Next lZeile
  ListBox1.Value = ListBox1.List(0)
  'Loop
'   ComboBox1.RowSource = "Tabelle2!A3:A10"
'   ComboBox2.RowSource = "Tabelle2!B3:B15"
End Sub

Private Sub Textbox1_Enter()                                                                ' Datum Teil 1
  TextBox1.Value = Format(Date, "dd/mm/yyyy")
End Sub



Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)                            ' Datum Teil 2
  '   If TextBox1.Value = "" Then Exit Sub                                                    ' Textbox leer?
  '   If IsDate(TextBox1.Value) = False Then                                                  ' Ist es ein Datum?
  '      frm_Fehler.Show                                                                       ' Aufruf Fehlermeldung
  '      TextBox1.Value = ""                                                                  ' Löschen Inhalt Textbox
  '      TextBox1.SetFocus                                                                    ' Wiederanspringen dieser Textbox
  '      Cancel = True                                                                        ' Abbruchvariable setzen
  '      Exit Sub
  '   Else
  TextBox1.Value = Format(TextBox1.Value, "dd/mm/yyyy")                                    ' Formatierung des Datums
  'TextBox2.SetFocus                                                                        ' Anspringen nächste Textbox
  '   End If
End Sub

[Klaus-Dieter]

Hallo,

wer soll daraus das UserForm rekonstruieren?

[M.Wichmann]

Hallo,

habe mal eine etwas ältere Version hochgeladen.

Dort müßte jetzt ein zusätzlicher Button eingebaut werden, der nicht einen leeren Datensatz erzeugt, sondern sozusagen eine Kopie des aktuellen Eintrages unter einer neuen ID.

[M.Wichmann]

Hallo,

ich habe schon ein wenig alleine weitergemacht.

Ich habe es hinbekommen, das die UF die neue Id vergibt und die Zellen füllt. Aber die Listbox springt nicht wie bei einem neuen Eintrag in diese Zeile. Obwohl ich ziemlich den selben Code habe wie bei dem Neuen Eintrag. 

Wo ist der fehler??

Hier der Code des neuen Buttons:

Code:

Private Sub CommandButton2_Click()


Dim lZeile As Long
  Dim loLetzte As Long
 
  'Wenn der Benutzer einen neuen Eintrag erzeugen möchte,
  'erstellen wir einen neuen Eintrag in der ListBox und markieren
  'diesen, damit der Benutzer die Daten eintragen kann
 
  loLetzte = Tabelle1.Cells(Rows.Count, 1).End(xlUp).Row           ' letzte belegte in Spalte A (1)
  lZeile = loLetzte + 1
  'Nun steht lZeile in der ersten leeren Zeile von Tabelle1
  'Neuen Eintrag in die Tabelle1 schreiben, Spalte ID muss gefüllt sein, damit
  'unsere Routinen die Zeile wiederfinden!
  Tabelle1.Cells(lZeile, 1) = " " & lZeile
   
   Tabelle1.Cells(lZeile, 8).Value = TextBox1.Text
        Tabelle1.Cells(lZeile, 3).Value = TextBox2.Text
        Tabelle1.Cells(lZeile, 4).Value = cbArt.Text
        Tabelle1.Cells(lZeile, 5).Value = TextBox4.Text
        Tabelle1.Cells(lZeile, 6).Value = TextBox5.Text
        'Tabelle1.Cells(lZeile, 1).Value = TextBox6.Text
        Tabelle1.Cells(lZeile, 7).Value = TextBox7.Text
        Tabelle1.Cells(lZeile, 3).Value = cbKunde.Text
       
         ListBox1.ListIndex = ListBox1.ListCount - 1

End Sub

[Steffl]

Hallo Michael,

hast Du den Ablauf des Codes auch im Einzelschritt geprüft?

[M.Wichmann]

Hallo,

wenn ich das mit den Einzelschritten laufen lasse, verhält es sich genauso wie bei dem Macro für den neuen leeren Eintrag.

Beide springen in:

Private Sub UserForm_Initialize()

und springen dann immer zwischen diesen beiden Einträgen hin und her:

 ListBox1.AddItem Tabelle1.Cells(lZeile, 1).Value

   Next lZeile

[Steffl]

Hallo Mario,

und springen dann immer zwischen diesen beiden Einträgen hin und her:

 ListBox1.AddItem Tabelle1.Cells(lZeile, 1).Value

   Next lZeile

Klar, ist eine Schleife, die eben so oft wiederholt wird, wie es eine Codezeile bei Schleifebeginn festgelegt wurde. Du könntest eine Zeile unterhalb von Next lZeile einen Haltepunkt setzen. Dies geht mit der F9-Taste bzw. durch einen Klick auf den grauen Rand neben dem Codefenster. Drücke dann die F5-Taste und Excel hält bei dieser Position an. Schau dir auch im Kontextmenü von Debuggen die Tastenkombinationen an.

Gruß Stefan

PS: Sorry, das ich dich in meiner letzten Antwort mit Michael angeredet habe.

[M.Wichmann]

Hallo,

danke für die Hinweise, die liefen beide gleich ab.

Aber ich denke ich habe es gefunden, da fehlte eine Zeile im "neuen" Code:

ListBox1.AddItem Tabelle1.Cells(lZeile, 1)

Jetzt Kopiert die UF den Inhalt in eine neue Zeile.

Jetzt wäre ich aber noch für einen anderen Tip Dankbar.
Und zwar ist die Textbox1 ja für das Datum, wenn ich in diese Klicke wird das aktuelle Datum eingetragen.
Jetzt wäre es aber von Vorteil, das dort nur das aktuelle datum eingetragen wird, wenn noch kein Datum in der Zielzelle vorhanden ist. Also bei einem ganz neuen Eintrag.

[Steffl]

Hallo Mario,

vielleicht so?

Code:

Private Sub TextBox2_Enter()
   If TextBox2.Value = "" Then TextBox2.Value = Date Else MsgBox "Schon befüllt"
End Sub

[M.Wichmann]

Hallo Stefan,

danke dafür, funktioniert soweit.

Jetzt muss ich nur noch die Tabelle wieder etwas umbauen, und probieren ob es generell so funktioniert wie ich es mir dachte.

Aber das werde ich wohl erst Montag schaffen, werde aber Rückmeldung geben.