VBA, automatisch zahlen einfügen mit Zeilen Einfügung

[Niko]

Hallo an alle, hier ein kleines Thema mit Nummerierung von Zeilen.
Habe ein kleine Code aus dem Internet der sehr gut funktioniert, möchte diesen aber umbauen so das wenn ich Zwischen den Zeilen neue Zeile einfügen sich bei dieser Zeile o,1 die zahl verändert.

Beispiel: Wenn ich eine Zeile zwischen 3 und 4 einfügen soll diese Zeile 3.1 sein und müsste die Reihenfolge dann 3 - 3.1 - 4 sein. Bei neuer Zeile zwischen 3 und 3.1 müsste es dann 3 - 3.1 - 3.2 - 4 sein, alle anderen Zeilen nach unten um eine Zeile weiter verschieben.


zur zeit ist mit den Code nur möglich, wenn ich eine Zahl zwischen 3 und vier einfüge das die unter zahlen der eingefügten Zeile um eine Zeile und Nummerierung nach unten verschieben.

Anbei der vorhanden Code:

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim bereich As Range
Dim z
Dim zelle
z = UsedRange.Rows.Count
Set bereich = Range(Cells(1, 1), Cells(z, 1))
For Each zelle In bereich
zelle.Formula = "=row()"
Next
End Sub

Anbei auch die Datei: 
  VBA_Zeillen_Nummerierung.xlsm (Größe: 18,87 KB / Downloads: 5)

Danke im Voraus,

[schauan]

Hallöchen,

Dein Makro ändert nichts. Es werden bei jedem Durchlauf alle Formeln, die die Zeilenzahl wiedergeben, neu gesetzt.
Das könntest Du auch einfacher mit einer intelligenten Tabelle ohne Makro erreichen.

Wenn Du einmal das Grundgerüst hast - da kannst Du 1-2-3 in 3 Zellen eintragen und so weit nötig runter ziehen, würde ich die Änderungen manuell vornehmen, dann benötigst Du kein Makro in der Datei.

[Niko]

Ich glaube ich habe mich nicht klar ausgedrückt, mein Fehler.

mein vorhaben ist,

von dieser Reihenfolge bei Zeilen einfügen                          auf diese Art die Zeilen einzufügen
1                                                                                      1
2                                                                                      2
3                                                                                      2.1
4                                                                                      2.2
5                                                                                      2.3
6                                                                                      3
7                                                                                      4
8                                                                                      5
9                                                                                      6

wenn ich die Zeilen in 3,4,5 einfüge soll es sich wie in der zweiten Reihe ändern und nicht wie in der ersten Reihe.

Danke,

[schauan]

Hallöchen,
Du hast Dich schon klar ausgedrückt, daher mein Vorschlag.

[Niclaus]

Hallo Namensvetter

Ich lade Dir eine "umgebastelte" Datei mit verschiedenen Makros hoch.
 
a) Wenn Du am Ende der Tabelle eine noch nicht nummerierte Zelle/Zeile anklickst, wird die Nummerierung fortgesetzt. Wenn Du in der hochgeladenen Datei eine Zelle in der Zeile 19 anklickst, wird in A19 die neue Nummer 13 eingefügt. – Wenn Du aber Zeilen überspringst und z. B. B22 anklickst, geschieht nichts – Du erhältst eine entsprechende Meldung.
 
b) "Zeile einfügen": Du klickst eine Zelle oder Zeile an, über der die neue Nummerierung (mit "0.1" usw.) eingefügt werden soll, und klickst den entsprechenden Makro-Button an.
Probleme kann es geben – und Du wirst darauf aufmerksam gemacht – wenn Du z. B. zwischen 4.2 und 4.3 eine neue Zeile einfügst: Du hast dann zwei Zeilen mit der Nummer 4.3.
Auch wenn Du z. B. eine Zeile 4.9 hast und Du fügst darunter eine neue Zeile ein. Die neue Zeile würde dann "5" heissen. Diese Zeile 5 ist ja aber bereits vorhanden. – Ev. müsste man die Zählung ändern: Statt mit 0.1 könnte man mit 0.01 erhöhen.
 
c) Und dann noch ein Button "ganz neu nummerieren": Spalte A wird durchnummeriert ohne 0.1-Nummern, in meiner Datei also von 1 - 18. Das entspricht dem Makro "Worksheet_SelectionChange()", das Deine von Dir hochgeladene Datei enthält.
 
Ich hoffe, meine Basteleien helfen Dir.
Grüsse Niclaus

[Niko]

Vielen Dank für die Mühe, ich kann nachvollziehen was gemeint ist, könnte diesen Lösungsvorschlag als Notlösung gebrauchen
...auch wenn es mir lieber wäre auf den einfachen vorhanden Code mit nur Zeile einfügen, wo diese gebraucht wird, sich alles automatisch einfügt.
Mein Zusatz Gedanke wäre, Spalte vorzu nummerieren und dann, bei neuen Zeilen einfügen zwischen den nummerierten Zeilen das sich um 0,1 erhöht 
(zwischen 1 und 1.1 darf dann keine neue Zeile eingefügt werden können).

Wäre dies möglich in den vorhandenen Code einzubauen?
Würde mich über ein Lösungsvorschlag freuen.

Danke für die bisherige mühe,

[schauan]

Hallöchen,

hier mal mein Vorschlag. Wenn Du eine Zeile eingefügt hast, musst Du nochmal irgendwohin klicken...

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Variablendeklarationen
Dim lrow&, iCnt&, iDez1%, iDez2%, iVal#
'letzte belegte zeile in Spalte A feststellen
lrow = Cells(Rows.Count, 1).End(xlUp).Row
'Schleife bis Zeile lrow
For iCnt = 2 To lrow
  'Wenn die Zelle leer ist, dann
  If Cells(iCnt, 1).Value = "" Then
    'dezimalzahl vor lerer Zelle ermitteln
    iVal = Cells(iCnt - 1, 1).Value - Fix(Cells(iCnt - 1, 1).Value)
    'Anzahl dezimalstellen ermitteln
    iDez1 = Len(Str(iVal)) - 1
    'dezimalzahl nach lerer Zelle ermitteln
    iVal = Cells(iCnt + 1, 1).Value - Fix(Cells(iCnt + 1, 1).Value)
    'Anzahl dezimalstellen ermitteln
    iDez2 = Len(Str(iVal)) - 1
    'wenn vor und nach der Zelle die gleiche Anzahl dezimalstellen sind, dann
    'eine dezimalstelle mehr einfuegen
    If iDez1 = iDez2 Then
      Cells(iCnt, 1).Value = Cells(iCnt - 1, 1).Value + (1 / WorksheetFunction.Power(10, iDez1))
    'ansonsten
    Else
      'gleiche Anzahl dezimalstellen verwenden
      Cells(iCnt, 1).Value = Cells(iCnt - 1, 1).Value + (1 / WorksheetFunction.Power(10, iDez1 - 1))
    'Ende wenn vor und nach der Zelle die gleiche Anzahl dezimalstellen sind, dann
    End If
  'Ende Wenn die Zelle leer ist, dann
  End If
'Ende Schleife bis Zeile lrow
Next
End Sub

[Niko]

DANKE!!! ...genau so habe ich es mir vorgestellt...merci