Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1800to1804
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

Unternummerierung per VBA

Unternummerierung per VBA
05.01.2021 14:05:16
Dani
Hallo Zusammen
Ich brauche einen Denkanstoss bezüglich folgendem Problem:
Ich habe eine Tabelle welche ich eine Nummerierung eingefügt habe bestehend aus "O 20-001" Nut möchte ich das per Comandbutton bei Bedarf eine "unternumerierung" eingfügt wird. Dabei soll wie im Beispiel unten ersichtlich die nummerierung mit 002.x fortgeführt werden. (x weil die nummer fortlaufen sein soll, sprich es soll gleichzeitig geprüft werden ob eine "unternummerierung" dazu bereits vorhanden ist und dort fortfahren.)
O 20-001
O 20-002
O 20-002.1
O 20-002.2
O 20-002.x
O 20-003
So viel dazu was ich machen möchte. Folgend mein bisheriger Code:
  • 
    Private Sub CommandButton3_Click() 'Unternummer einfügen
    Dim Was, c, fA, b
    Was = ComboBox1
    With ActiveSheet.Cells
    Set c = .Find(Was, LookIn:=xlValues)
    Set b = c
    If Not c Is Nothing Then
    fA = c.Address
    Rows(c.Row + 1).Insert
    c.Offset(1, 0) = c
    End If
    End With
    Unload UserForm1
    End Sub
    

  • Mit meinem Code erreiche ich das der Inhalt einer Combobox gesucht wird und darunter eine neue Zeile eingefügt wird sowie der gefundene Ihnalt darunter. (Bsp. Gesucht O 20-001, gefunden und darunter O 20-001 eingefügt) Mein Ziel ist es jetzt jedoch darunter die neue Nummerierung einzufügen. Ich weiss jedoch nicht wie ich die "unternumerierung" hinkriege.
    Ich denke da in die Richtung, dass ich mittels meinem definierten "b" arbeiten muss. (Verinfacht gesagt c (20-001) +0.1 wobei die 0.1 natürlich variabel sein müssete.
    Für einen Tipp oder eine alternative Möglichkeit wäre ich sehr erfreut.
    Vielen Dank im voraus
    Gruss Dani

    6
    Beiträge zum Forumthread
    Beiträge zu diesem Forumthread

    Betreff
    Datum
    Anwender
    Anzeige
    AW: Unternummerierung per VBA
    05.01.2021 15:55:20
    Matthias
    Moin!
    Auf die schnelle mal eine Idee.
    Du splittest den suchwert beim Punkt. Dann wertest du das entstandene array aus. Gibt es nur einen Eintrag, hängst du .1. Ansonsten nimmst du den zweiten Wert und addierst 1.
    bspw. so:
    If UBound(Split(was, ".")) = 0 Then
    Debug.Print was & ".1"
    Else
    Debug.Print Split(was, ".")(0) & "." & CLng(Split(was, ".")(1)) + 1
    End If
    

    Du müsstest dabei noch prüfen, ob hinter dem Punkt wirklich eine Zahl steht. Bei .asd läuft das sonst in einen FEhler.
    VG
    AW: Unternummerierung per VBA
    05.01.2021 19:03:47
    Yal
    Moin Dani,
    man kann UDF (User Defined Function) verwenden. Entweder im Blatt oder im Code
    Public Function MaxUnterversion(Element, Bereich, Optional Trenner = ".") As Integer
    Dim Z
    Dim HV As String
    Dim MUV As Integer
    HV = Hauptversion(Element, Trenner)
    For Each Z In Bereich.Cells
    MUV = WorksheetFunction.Max(MUV, Unterversion(Z, Trenner))
    Next Z
    MaxUnterversion = MUV
    End Function
    Public Function Unterversion(Target, Optional Trenner = ".") As Integer
    On Error Resume Next
    Unterversion = 0
    Unterversion = CInt(Split(Target.Value, ".")(1))
    End Function
    Public Function Hauptversion(Target, Optional Trenner = ".") As String
    On Error Resume Next
    Hauptversion = Target.Value
    Hauptversion = Split(Target.Value, Trenner)(0)
    End Function
    
    Wenn ich deine 6 Beispiele in A1:A6 reinlege, nehme ich in A7:
    =Hauptversion(A6)&"."&MaxUnterversion(A6;A1:A6)+1
    oder man verwendet diese im Code von CommandButton3_Click.
    Viel Erfolg
    Yal
    Anzeige
    AW: Unternummerierung per VBA
    06.01.2021 14:22:15
    Dani
    Hallo Zusammen
    Vielen Dank für Eure Hilfe. Ich wäre mit den aktuellen VBA-Kenntnissen nicht auf eine Lösung gekommen. Yal Ich weiss nicht ob deine Lösung klappen würde. Ich habe zuerst die Variante von VG benutzt und für mich angepasst (Auch weil deine Lösung mein Niveau (noch) übersteigt). Mir ist erst im Nachhinein in den Sinn gekommen, dass ich über meine Userform einfach die Letzte Unternummer auswählen könnte... Das würde mir die Prüfung welche Unternummern bereits vorhanden sind ersparen.
    Hier folgend mein vollständiger Code welcher bei mir funktioniert.
    Private Sub CommandButton3_Click() 'Unternummer einfügen
    Dim Was, c, fA
    Was = ComboBox1
    With ActiveSheet.Cells
    Set c = .Find(Was, LookIn:=xlValues)
    If Not c Is Nothing Then
    fA = c.Address
    Rows(c.Row + 1).Insert
    If UBound(Split(c, ".")) = 0 Then
    c.Offset(1, 0) = c & ".1"
    Else
    c.Offset(1, 0) = Split(Was, ".")(0) & "." & CLng(Split(Was, ".")(1)) + 1
    End If
    End If
    End With
    Unload UserForm1
    End Sub
    

    Vielen Dank nochmals für die Hilfe.
    Gruss Dani
    Anzeige
    AW: Unternummerierung per VBA
    07.01.2021 14:03:54
    Yal
    hallo Dani,
    "Yal Ich weiss nicht ob deine Lösung klappen würde". Wie wäre's mit probieren?
    Way to go:
    _ Visual Basic Editor öffnen (Alt+F11),
    _ Modul einfügen (Alt+e, m),
    _ Code copy-pasten,
    _ Funktion als ganz normale Funktion in Excel verwenden.
    Mehr als das ist es nicht.
    VG
    Yal
    AW: Unternummerierung per VBA
    07.01.2021 19:35:06
    Dani
    Hallo Yal
    Danke für deine Bemühung und ja natürlich wäre es schnell geprüft. Jedoch habe ich den anderen Code besser verstanden, bereits angepasst und die Tabelle entsprechend erweitert. Dadurch wäre der Aufwand wieder grösser und somit bleibe ich lieber bei der bereits funktionierenden Variante.
    Danke trotzdem für deinen Tipp
    Anzeige
    AW: Unternummerierung per VBA
    07.01.2021 19:54:53
    Yal
    Das Vorteil der Methode mit Regular Expression (RegEx) ist, dass es extrahiert jede "nicht Zahl" raus:
    aus A1B2C3 wird ABC,
    aus 123def456 wird def
    ...

    Links zu Excel-Dialogen

    Beliebteste Forumthreads (12 Monate)

    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige