Gliederungsnummern umwandeln

Hallo Excelgemeinde,
ich habe folgendes Problem, bei dem ich Hilfe brauche.
Ich habe in einer Tabelle sehr viele Daten. Diese haben in der Spalte G eine Gliederungsnummer.
z.B.: 5.1.1.2 oder auch 5.10
Maximal sind es aber 4 Stellen. Wenn ich nun einen neuen Artikel in die Tabelle aufnehme, dann würde ich diese gerne anschließend sortieren. Dann habe ich aber leider die Artikelnummer 5.10 vor dem Artikel 5.2 und das soll nicht sein. Meine Idee ist es nun, in einer anderen Spalte eine Zuordnungsnummer automatisch zu generieren. Am besten wäre es, wenn das Ergebnis dann so aussehen würde:
Aus 5.1.1.2 soll 005001001002 werden und aus 5.10 soll 005010000000 werden. Alle 4 Stellen zwischen den Punkten würden somit wiederum 3 Stellen erhalten
Dann kann ich die Tabelle sortieren. Ich möchte gerne, dass ganze in VBA, damit ich das ganze dann im Ereignis: Private Sub Worksheet_Change(ByVal Target As Range) einbauen kann.
Ich hoffe, ich habe es nicht zu umständlich erklärt.?
Ich hoffe auf eure Hilfe!!!!
Gruß Dirk

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 7 And Target.Count = 1 Then If Target "" Then Application.EnableEvents = False With Target.Offset(, 1) .NumberFormat = "@" .Value = MeineNummer(Target) End With Application.EnableEvents = True End If End If End Sub

Function MeineNummer(strNummer) Dim arrtmp, i As Integer arrtmp = Split(strNummer, ".") For i = 0 To UBound(arrtmp) MeineNummer = MeineNummer & Format(arrtmp(i), "000") Next MeineNummer = Left(MeineNummer & String(12, "0"), 12) End Function

<pre>Sub struktur_aufschlüsseln()
Set rng = Range("G:G").SpecialCells(xlCellTypeConstants)
Range("A3:E7,H3:J7").ClearContents
For Each zell In rng
'Strukturtiefe ermitteln
trennpunkte = Len(zell.Value) - Len(Replace(zell.Value, ".", ""))
erste = InStr(1, zell.Value, ".")
zweite = InStr(erste + 1, zell.Value, ".")
dritte = InStr(zweite + 1, zell.Value, ".")
If trennpunkte = 1 Then
Cells(zell.Row, 8) = Format(Left(zell.Value, erste - 1), "'000 ") & _
Format(Mid(zell.Value, erste + 1), "000 ") & _
Format(0, "000 ") & _
Format(0, "000")
ElseIf trennpunkte = 2 Then
Cells(zell.Row, 8) = Format(Left(zell.Value, erste - 1), "'000 ") & _
Format(Mid(zell.Value, erste + 1, zweite - erste), "000 ") & _
Format(Right(zell.Value, InStr(StrReverse(zell.Value), ".") - 1), "000 ") & _
Format(0, "000")
ElseIf trennpunkte = 3 Then
Cells(zell.Row, 8) = Format(Left(zell.Value, erste - 1), "'000 ") & _
Format(Mid(zell.Value, erste + 1, zweite - erste), "000 ") & _
Format(Mid(zell.Value, zweite + 1, dritte - zweite), "000 ") & _
Format(Right(zell.Value, InStr(StrReverse(zell.Value), ".") - 1), "000 ")
End If
Next
End Sub</pre>

Beliebteste Forumthreads (12 Monate)

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread