Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1880to1884
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
Inhaltsverzeichnis

Nummerierung

Nummerierung
25.04.2022 21:17:47
Ramadani
Hallo zusammen
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

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Nummerierung
25.04.2022 22:30:05
Yal
Ja, aber echt, was für eine Unordnung hier ;-)
Hallo Ramadani,
Versuche mit folgendes:

Private Sub Box20_Click()
With ActiveSheet.Cells(Rows.Count, 1).End(xlUp) 'letzbefüllte Zelle in Spalte A
.Offset(1, 0) = WorksheetFunction.Max(Tabelle1.Range("A:A")) + 1 'Zähler
.Offset(1, 1) = Box22 'Datum eintragen
.Offset(1, 2) = Box4 'Anlagen - Nummer
.Offset(1, 3) = Box6 'Maschinen - Stunden
.Offset(1, 4) = Box9 'Wellennummer
.Offset(1, 5) = Box11 'Wellennummer
.Offset(1, 6) = Box14 'Wellennummer
.Offset(1, 7) = Box16 'Wellennummer
.Offset(1, 8) = Box18 'Hinweis
End With
Unload Me
End Sub
Wenn Du deine Boxen "g'scheid" nummerieren würdest, könnte man mit einer Schleife die Codelänge reduzieren.
z.B. so:

Private Sub Box40_Change()
Dim Zeile As Long
Dim i, j
'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
For i = 2 To 9
If InStr(1, Tabelle1.Cells(Zeile, i), Me.Box40.Value, vbTextCompare) Then
Me.Liste.AddItem Tabelle1.Cells(Zeile, 1).Value
For j = 1 To 8
Me.Liste.List(Me.Liste.ListCount - 1, j) = Tabelle1.Cells(Zeile, j + 1).Value
Next
Exit For
End If
Next
Next Zeile
End Sub
VG
Yal
Anzeige
AW: Nummerierung
26.04.2022 07:30:10
Ramadani
Guten Morgen Yal
Die Nummerierung funktioniert hervorragend :D
Ich danke dir sowohl für den Tipp mit der Nummerierung als auch für den Hinweis, die Boxen "g'scheider" zu nummerieren :)
Gruss
Hixi
Wobei...
26.04.2022 14:26:44
Yal
...kann man auch was draus machen:

Private Sub Box20_Click()
Dim n, i
With ActiveSheet.Cells(Rows.Count, 1).End(xlUp) 'letzbefüllte Zelle in Spalte A
.Offset(1, 0) = WorksheetFunction.Max(Tabelle1.Range("A:A")) + 1 'Zähler
For Each n In Array(22, 4, 6, 9, 11, 14, 16, 18)
i = i + 1
.Offset(1, i) = Me.Controls("Box" & n)
Next
End With
Unload Me
End Sub
VG
Yal
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige