automatische Nummerierung über combobox

Hallo,
über eine Userform kann ich Inhalte in eine Excelliste schreiben.
Der Inhalt wird manuell in ein Textfeld eingeben, die Gliederungspunkte sollen aber vorgegeben sein, an welche Stelle der Inhalt eingefügt werden soll.
Habe das Aktuell gelöst mit der Auswahl:
9.x
9.1.x
9.1.1.x
Wie schaffe ich es aber, wenn ich auf "speichern" klicke, dass das x zu der richtigen Nummer umgewandelt wird?
Also der Fall z.B.
Auswahl: 9.1.x
es gibt schon
9.1.1
9.1.2
::: 9.1.3 wäre der richtige Punkt
Wie schaffe ich das? Stehe hier komplett auf dem Schlauch und gar kein Ansatz.
Anbei habe ich ein Teilmakro, der dieses Problem betrifft angehängt!
https://www.herber.de/bbs/user/103970.xlsm
Danke für Hilfe!
Gruß Alex

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Alex,
deine Userform funktioniert nicht so ganz, da du das Blatt 'Kategorie' gelöscht hast. Daher habe ich eine kleine Trockenübung gemacht und hoffe du kannst sie in deinen Code integrieren:
Nutze zunächst die Suchfunktion. Schneide das "x" hinten ab und suche nach Teil-Strings (LookAt:=xlPart). Wenn du dabei den Suchterm mit der Funktion Split anhand seiner Punkte aufteilst, bist du das Problem mit mehrstelligen Zahlen sicher umgangen.
Gefundene Ergebnisse splitest du ebenfalls auf und vergleichst die Anzahl der Teilstücke. Wenn sie nicht gleich sind, hast du eine Unterkategorie erwischt. Sind sie gleich, so schaust du dir das letzte Teilstück an. Ist es höher als dein Zähler, so merkst du dir es. Das ganze wiederholen bis du keine neuen Zellen mehr findest.
Der höchste Zähler ist die letzte Kategorie, den musst du also nur noch um 1 erhöhen.
lg Steve

Sub Test()
Dim wks As Worksheet
Dim sSuch As String, vFund, vSuch, lZaehler As Long, i As Long
Dim rZelle As Range, sFirstAddress As String
'Bsp: "8.1.X" gewählt
vSuch = Split("8.1.X", ".") ' = Split(Combobox1, ".")
For i = 0 To UBound(vSuch) - 1
If i = 0 Then
sSuch = vSuch(0) & "."
Else
sSuch = sSuch & vSuch(i) & "."
End If
Next i
Set wks = Sheets("8.FFZ_Neubau")
If sSuch  "" Then
With wks.Range("A:A") 'Suchbereich
Set rZelle = .Find(What:=sSuch, LookAt:=xlPart)
If Not rZelle Is Nothing Then
sFirstAddress = rZelle.Address
Do
vFund = Split(rZelle, ".")
If UBound(vFund) = UBound(vSuch) Then 'wenn gleiche Ebene merke dir Zahl
If vFund(UBound(vFund)) > lZaehler Then lZaehler = vFund(UBound(vFund))
End If
Set rZelle = .FindNext(rZelle)
Loop While Not rZelle Is Nothing And rZelle.Address  sFirstAddress
Else 'Wenn nichts gefunden
End If
End With
sSuch = sSuch & lZaehler + 1
End If
MsgBox "Ergebnis: " & sSuch
End Sub

Private Sub UserForm_Initialize() Dim rng As Range Dim WS As Worksheet Set WS = Worksheets(Kategorie) With Me.ComboBox1 For Each rng In WS.Range(WS.Cells(1, 1), WS.Cells(Rows.Count, 1).End(xlUp)) .AddItem rng.Value & ".x" Next rng End With End Sub

Private Sub CommandButton1_Click() 'Speichern Dim WS As Worksheet Dim xZeile As Long, i As Long, y As Long Set WS = ThisWorkbook.Worksheets(Kategorie) If TextBox2 = "" Then Exit Sub Application.ScreenUpdating = False xZeile = WS.Range("A65536").End(xlUp).Row y = -1 For i = 1 To xZeile Debug.Print Left(WS.Cells(i, 1), InStrRev(WS.Cells(i, 1), ".")) If Replace(Left(WS.Cells(i, 1), InStrRev(WS.Cells(i, 1), ".")), " ", "") = Left(ComboBox1, _ Len(ComboBox1) - 1) Then If y

Beliebteste Forumthreads (12 Monate)

automatische Nummerierung über combobox

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

automatische Nummerierung über combobox

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

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread