'entwickelt von Winfried Radner
'e-mail: Wolf.W.Radzinski@onlinehome.de
'Benutzung frei - ohne Gewähr

'damit übergebe ich ob eine Zeile geändert wurde
Global merker As Boolean



Public Sub neue_zeilennr()
On Error GoTo abbruch
merker = False
Dim zelle As Range
startnummer = CLng(InputBox("Startnummer", "Bitte wählen Sie", ""))
inkrement = CLng(InputBox("Inkrement", "Bitte wählen Sie", ""))
fixe_laenge = CLng(InputBox("fixe Länge 0=aus bis 10 Stellen", "Bitte wählen Sie", ""))
If fixe_laenge > 10 Then GoTo abbruch
nur_chr = ""

'soll z.B. nur nach N die Zeilennummer geändert werden, dann N hier eingeben!
'sonst einfach leer lassen!

nur_chr = InputBox("nur Zahlen nach Buchstabe", "Bitte wählen Sie", "")

Cursor = xlWait
Application.ScreenUpdating = False

For Each zelle In Selection
a = ActiveSheet.UsedRange.Rows.Count
b = ActiveSheet.UsedRange.Columns.Count
  
  'Abbruch wenn Datenende erreicht,
  'sonst flackert der Bildschirm bis 65535 Zeilen
  'nutzlos vor sich hin
  If zelle.Row > a Or zelle.Column > b Then GoTo abbruch

  If fixe_laenge > 0 Then
      zelle = new_lnr(zelle, Right("0000000000" & CStr(startnummer), fixe_laenge), nur_chr)
  Else
     zelle = new_lnr(zelle, CStr(startnummer), nur_chr)
  End If
  'Zeilennummer nur erhöhen, wenn auch was geändert wurde!
  If merker Then
     startnummer = startnummer + inkrement
     merker = False
  End If
Next
abbruch:
Cursor = xlDefault
Application.ScreenUpdating = True

End Sub

Public Function new_lnr(alter_Text As Range, zstr As String, Optional nur_nach = "") As String
On Error Resume Next
new_lnr = ""
If Len(alter_Text.Text) > 0 Then
    pos = 1: i = 0: anfang = False: ende = False
    Do
    
       ziffer = Mid(alter_Text.Text, pos + i, 1)
       
       'hier wird einfach jede Zeile geändert,
       
       If nur_nach = "" Then
       Select Case ziffer
         Case "0" To "9", ".", ",", "-", "+": pos = pos + i
                                              anfang = True
         Case Else: i = i + 1
       End Select
       Else
       'hier werden nur Nummern ersetzt, die den Chr -> nur_nach davor haben!,
       
       Select Case ziffer
         Case nur_nach: pos = pos + i
                        anfang = True
                        merker = True
         Case Else: i = i + 1
       End Select
       
       End If
    Loop Until anfang Or i = Len(alter_Text.Text)
    i = 1
    
    'hier wird das ENDE der Zahl gesucht
    
    Do
      ziffer = Mid(alter_Text.Text, pos + i, 1)
      Select Case ziffer
        Case "0" To "9", ".", ",": i = i + 1
        Case Else: ende = True
      End Select
    Loop Until ende Or i + pos > Len(alter_Text.Text)
    
    'hier wird ersetzt oder der alte Text übergeben
    
    If nur_nach = "" Then
      If pos = 1 Then
        new_lnr = zstr & Right(alter_Text.Text, Len(alter_Text) - i - pos + 1)
      Else
        new_lnr = Left(alter_Text.Text, pos - 1) & zstr & Right(alter_Text.Text, Len(alter_Text) - i - pos + 1)
      End If
    Else
        If anfang Then
           new_lnr = Left(alter_Text.Text, pos) & zstr & Right(alter_Text.Text, Len(alter_Text) - i - pos + 1)
        Else
           new_lnr = alter_Text.Text
        End If
    End If
End If
End Function