Nummerierung
25.04.2022 21:17:47
Ramadani
Ich hab da ein Problem bei dem ich leider nicht mehr weiter komme und auch nichts passendes im Internet finde.
Und zwar geht es um folgendes:
Ich habe eine Liste wo fortlaufend neue Daten aufgenommen werden. Hierfür habe ich eine UserForm erstellt, um die benötigten Daten einzugeben.
Mit meinen Kenntnissen und ein bisschen Hilfe im Internet konnte ich schon folgendes integrieren: die nächste Leere Zeile auswählen für die Datenübertragung von der UserForm in die Tabelle - Listbox füllt sich laufend mit den neuen Daten - das scrollen in der Listbox und in den Comboboxen - in den Textboxen ist nur die Eingabe von Zahlen möglich - usw.
Mir fehlt lediglich, dass mir über einen VBA - Befehl eine fortlaufende Nummer generiert wird, sobald ich auf den Button "Daten übernehmen" drücke.
Die Nummerierung soll ab Zeile A3 anfangen und würde dann fortgeführt werden beim betätigen des Buttons.
Geht sowas überhaupt :D
Der Befehl sieht bisher so aus:
Private Sub Box19_Click()
'Abbrechen - Button
Unload Me
End Sub
Private Sub Box20_Click()
'Erste freie Zeile ausfindig machen
Dim last As Integer
last = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
'Datum eintragen
Cells(last, 2).Value = Box22
'Anlagen - Nummer
Cells(last, 3).Value = Box4
'Maschinen - Stunden
Cells(last, 4).Value = Box6
'Wellennummer
Cells(last, 5).Value = Box9
'Wellennummer
Cells(last, 6).Value = Box11
'Wellennummer
Cells(last, 7).Value = Box14
'Wellennummer
Cells(last, 8).Value = Box16
'Hinweis
Cells(last, 9).Value = Box18
'Abbrechen
Unload Me
End Sub
Private Sub Box21_Click()
'aktuelles Datum eintragen
Me.Box22.Value = Format(Now, "dd.mm.yy")
End Sub
Private Sub Box22_AfterUpdate()
If IsDate(Me.Box22.Text) Then
Me.Box22.Text = Format(Me.Box22.Text, "dd.mm.yy")
End If
End Sub
Private Sub Box4_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'scrollen
Call HookListBoxScroll(Me, Me.Box4)
End Sub
Private Sub Box9_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'scrollen
Call HookListBoxScroll(Me, Me.Box9)
End Sub
Private Sub Box11_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'scrollen
Call HookListBoxScroll(Me, Me.Box11)
End Sub
Private Sub Box14_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'scrollen
Call HookListBoxScroll(Me, Me.Box14)
End Sub
Private Sub Box16_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'scrollen
Call HookListBoxScroll(Me, Me.Box16)
End Sub
Private Sub Box40_Change()
Dim Zeile As Long
'Liste leeren
Me.Liste.Clear
'Schleife über alle Zeilen in der Tabelle
For Zeile = 3 To Tabelle1.Cells(Rows.Count, 2).End(xlUp).Row
'Suchfenster auswählen
If InStr(1, LCase(Tabelle1.Cells(Zeile, 2).Value), LCase(Me.Box40.Value)) 0 Or _
InStr(1, LCase(Tabelle1.Cells(Zeile, 3).Value), LCase(Me.Box40.Value)) 0 Or _
InStr(1, LCase(Tabelle1.Cells(Zeile, 4).Value), LCase(Me.Box40.Value)) 0 Or _
InStr(1, LCase(Tabelle1.Cells(Zeile, 5).Value), LCase(Me.Box40.Value)) 0 Or _
InStr(1, LCase(Tabelle1.Cells(Zeile, 6).Value), LCase(Me.Box40.Value)) 0 Or _
InStr(1, LCase(Tabelle1.Cells(Zeile, 7).Value), LCase(Me.Box40.Value)) 0 Or _
InStr(1, LCase(Tabelle1.Cells(Zeile, 8).Value), LCase(Me.Box40.Value)) 0 Or _
InStr(1, LCase(Tabelle1.Cells(Zeile, 9).Value), LCase(Me.Box40.Value)) 0 Then
'Liste befüllen
Me.Liste.AddItem Tabelle1.Cells(Zeile, 1).Value
Me.Liste.List(Me.Liste.ListCount - 1, 1) = Tabelle1.Cells(Zeile, 2).Value
Me.Liste.List(Me.Liste.ListCount - 1, 2) = Tabelle1.Cells(Zeile, 3).Value
Me.Liste.List(Me.Liste.ListCount - 1, 3) = Tabelle1.Cells(Zeile, 4).Value
Me.Liste.List(Me.Liste.ListCount - 1, 4) = Tabelle1.Cells(Zeile, 5).Value
Me.Liste.List(Me.Liste.ListCount - 1, 5) = Tabelle1.Cells(Zeile, 6).Value
Me.Liste.List(Me.Liste.ListCount - 1, 6) = Tabelle1.Cells(Zeile, 7).Value
Me.Liste.List(Me.Liste.ListCount - 1, 7) = Tabelle1.Cells(Zeile, 8).Value
Me.Liste.List(Me.Liste.ListCount - 1, 8) = Tabelle1.Cells(Zeile, 9).Value
End If
Next Zeile
End Sub
'nur Zahlen zulassen
Private Sub Box6_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii >= Asc("0") And KeyAscii 8 Then
KeyAscii = 0
End If
Else
KeyAscii = 0
End If
End Sub
'nur Zahlen zulassen
Private Sub Box9_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii >= Asc("0") And KeyAscii 8 Then
KeyAscii = 0
End If
Else
KeyAscii = 0
End If
End Sub
'nur Zahlen zulassen
Private Sub Box11_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii >= Asc("0") And KeyAscii 8 Then
KeyAscii = 0
End If
Else
KeyAscii = 0
End If
End Sub
'nur Zahlen zulassen
Private Sub Box14_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii >= Asc("0") And KeyAscii 8 Then
KeyAscii = 0
End If
Else
KeyAscii = 0
End If
End Sub
'nur Zahlen zulassen
Private Sub Box16_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii >= Asc("0") And KeyAscii 8 Then
KeyAscii = 0
End If
Else
KeyAscii = 0
End If
End Sub
'nur Zahlen zulassen
Private Sub Box22_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii >= Asc("0") And KeyAscii 8 Then
KeyAscii = 0
End If
Else
KeyAscii = 0
End If
End Sub
Private Sub Liste_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'in der Liste scrollen
Call HookListBoxScroll(Me, Me.Liste)
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Call UnhookListBoxScroll
End Sub
Private Sub UserForm_Initialize()
'Überschrift
'Liste.ColumnHeads = True
Dim Zeile As Long
'Schleife über alle Zeilen in der Tabelle
For Zeile = 3 To Tabelle1.Cells(Rows.Count, 2).End(xlUp).Row
'Liste befüllen
Me.Liste.AddItem Tabelle1.Cells(Zeile, 1).Value
Me.Liste.List(Me.Liste.ListCount - 1, 1) = Tabelle1.Cells(Zeile, 2).Value
Me.Liste.List(Me.Liste.ListCount - 1, 2) = Tabelle1.Cells(Zeile, 3).Value
Me.Liste.List(Me.Liste.ListCount - 1, 3) = Tabelle1.Cells(Zeile, 4).Value
Me.Liste.List(Me.Liste.ListCount - 1, 4) = Tabelle1.Cells(Zeile, 5).Value
Me.Liste.List(Me.Liste.ListCount - 1, 5) = Tabelle1.Cells(Zeile, 6).Value
Me.Liste.List(Me.Liste.ListCount - 1, 6) = Tabelle1.Cells(Zeile, 7).Value
Me.Liste.List(Me.Liste.ListCount - 1, 7) = Tabelle1.Cells(Zeile, 8).Value
Me.Liste.List(Me.Liste.ListCount - 1, 8) = Tabelle1.Cells(Zeile, 9).Value
Next Zeile
'Erstes Element auswählen
Me.Liste.Selected(0) = True
'Entnahme
'Anlagen - Nummer
With Box4
.AddItem "L-2"
.AddItem "L-12"
.AddItem "L-14"
.AddItem "L-15"
.AddItem "L-16"
.AddItem "L-17"
.AddItem "L-18"
.AddItem "L-19"
.AddItem "L-20"
End With
With Box9
.AddItem "45.01"
.AddItem "45.02"
.AddItem "45.03"
.AddItem "45.04"
.AddItem "45.05"
.AddItem "45.06"
.AddItem "45.07"
.AddItem "45.08"
.AddItem "45.09"
.AddItem "45.10"
.AddItem "45.11"
.AddItem "45.12"
.AddItem "45.13"
.AddItem "45.14"
.AddItem "45.15"
.AddItem "45.16"
.AddItem "45.17"
.AddItem "45.18"
.AddItem "45.19"
.AddItem "45.20"
.AddItem "45.21"
.AddItem "45.22"
.AddItem "45.23"
.AddItem "45.24"
.AddItem "45.25"
.AddItem "45.26"
.AddItem "45.27"
.AddItem "45.28"
.AddItem "45.29"
.AddItem "45.30"
.AddItem "45.31"
.AddItem "45.32"
.AddItem "45.33"
.AddItem "45.34"
.AddItem "45.35"
.AddItem "45.36"
.AddItem "45.37"
.AddItem "45.38"
.AddItem "45.39"
.AddItem "45.40"
End With
With Box11
.AddItem "45.01"
.AddItem "45.02"
.AddItem "45.03"
.AddItem "45.04"
.AddItem "45.05"
.AddItem "45.06"
.AddItem "45.07"
.AddItem "45.08"
.AddItem "45.09"
.AddItem "45.10"
.AddItem "45.11"
.AddItem "45.12"
.AddItem "45.13"
.AddItem "45.14"
.AddItem "45.15"
.AddItem "45.16"
.AddItem "45.17"
.AddItem "45.18"
.AddItem "45.19"
.AddItem "45.20"
.AddItem "45.21"
.AddItem "45.22"
.AddItem "45.23"
.AddItem "45.24"
.AddItem "45.25"
.AddItem "45.26"
.AddItem "45.27"
.AddItem "45.28"
.AddItem "45.29"
.AddItem "45.30"
.AddItem "45.31"
.AddItem "45.32"
.AddItem "45.33"
.AddItem "45.34"
.AddItem "45.35"
.AddItem "45.36"
.AddItem "45.37"
.AddItem "45.38"
.AddItem "45.39"
.AddItem "45.40"
End With
With Box14
.AddItem "45.01"
.AddItem "45.02"
.AddItem "45.03"
.AddItem "45.04"
.AddItem "45.05"
.AddItem "45.06"
.AddItem "45.07"
.AddItem "45.08"
.AddItem "45.09"
.AddItem "45.10"
.AddItem "45.11"
.AddItem "45.12"
.AddItem "45.13"
.AddItem "45.14"
.AddItem "45.15"
.AddItem "45.16"
.AddItem "45.17"
.AddItem "45.18"
.AddItem "45.19"
.AddItem "45.20"
.AddItem "45.21"
.AddItem "45.22"
.AddItem "45.23"
.AddItem "45.24"
.AddItem "45.25"
.AddItem "45.26"
.AddItem "45.27"
.AddItem "45.28"
.AddItem "45.29"
.AddItem "45.30"
.AddItem "45.31"
.AddItem "45.32"
.AddItem "45.33"
.AddItem "45.34"
.AddItem "45.35"
.AddItem "45.36"
.AddItem "45.37"
.AddItem "45.38"
.AddItem "45.39"
.AddItem "45.40"
End With
With Box16
.AddItem "45.01"
.AddItem "45.02"
.AddItem "45.03"
.AddItem "45.04"
.AddItem "45.05"
.AddItem "45.06"
.AddItem "45.07"
.AddItem "45.08"
.AddItem "45.09"
.AddItem "45.10"
.AddItem "45.11"
.AddItem "45.12"
.AddItem "45.13"
.AddItem "45.14"
.AddItem "45.15"
.AddItem "45.16"
.AddItem "45.17"
.AddItem "45.18"
.AddItem "45.19"
.AddItem "45.20"
.AddItem "45.21"
.AddItem "45.22"
.AddItem "45.23"
.AddItem "45.24"
.AddItem "45.25"
.AddItem "45.26"
.AddItem "45.27"
.AddItem "45.28"
.AddItem "45.29"
.AddItem "45.30"
.AddItem "45.31"
.AddItem "45.32"
.AddItem "45.33"
.AddItem "45.34"
.AddItem "45.35"
.AddItem "45.36"
.AddItem "45.37"
.AddItem "45.38"
.AddItem "45.39"
.AddItem "45.40"
End With
End Sub