Laufende Nummer in formatiertem String hochzählen Funktion, um den hinteren numerischen Teil in einem beliebig formatieten String (z. B. eine Rechnungs-Nr) hochzuzählen.
Autor:   Denis Will	Bewertung:     [ Jetzt bewerten ]	Views:  22.952
www.gays-about.de	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 19 Bewertung insgesamt: gut Durchschnittliche Bewertung: 4.1 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Für ein VBA-Makro für Rechnungen hat sich diese Funktion als nützlich erwiesen. Aufgabe war, bei jedem Start auf Basis der zuletzt verwendeten Rechnungs-Nr. (z. B. "R-2002-01-0001") die nächste Rechnungs-Nr. automatisch zu erzeugen (z. B. "R-2002-01-0002"), indem zur letzten Ziffernkolonne eine 1 addiert wird.

Vorteil: Die Formatierung der Ausgangs-Rechungs-Nr. kann daher beliebig sein.

' Gibt einen Wert zurück, bei dem der hintere Teil um
' eins hochgezählt wird, wenn er als Zahl interpretiert
' werden kann, sonst wird "-1" angehangen.
' 
' Beispiele:
' StringIncrease("ABC-00123")  -->  "ABC-00124"
' StringIncrease("ABC")        -->  "ABC-1"
' =====================================================
Public Function StringIncrease(vValue As Variant) _
  As Variant
 
  ' Anzahl Zeichen des Übergabewertes
  Dim iLen As Integer
  iLen = Len(vValue)
 
  ' Stelle, an dem die letzte Nicht-Ziffer auftaucht
  Dim iPosSep As Integer
  iPosSep = iLen
 
  ' Aktuell gescanntes Zeichen im Übergabewert
  Dim sChar As Variant
  sChar = Mid(vValue, iPosSep, 1)
 
  ' Letzte Nicht-Ziffer suchen
  Do While IsNumeric(sChar) And iPosSep > 0
    iPosSep = iPosSep - 1
    If iPosSep > 0 Then
      sChar = Mid(vValue, iPosSep, 1)
    End If
  Loop
 
  ' Wenn letztes Zeichen keine Ziffer
  If iPosSep = iLen Then
    vValue = vValue & "-1"
    ' Sonst letzten Ziffern-Bereich manipuliern
  Else
    ' Anzahl Stellen des Ziffern-Bereiches
    ' (zunächst Original-Länge)
    Dim iDigitsCount As Integer
    iDigitsCount = Len(Right(vValue, iLen - iPosSep))
 
    ' Eins zum Ziffern-Bereich addieren
    Dim iDigits As Integer
    iDigits = CInt(Right(vValue, iLen - iPosSep)) + 1
 
    ' Wenn nun mehr Stellen benötigt werden,
    ' korrigieren
    If Len(Format(iDigits)) > iDigitsCount Then
      iDigitsCount = Len(Format(iDigits))
    End If
 
    ' Neu zusammensetzen
    vValue = Left(vValue, iPosSep) & _
      Format(iDigits, String(iDigitsCount, "0"))
  End If
 
  StringIncrease = vValue
End Function

Beispiel
Plaziere Sie auf eine Form eine TextBox und einen CommandButton und fügen Sie die Funktion StringIncrease in den Codeteil der Form ein.

Private Sub Command1_Click()
  Text1.Text = StringIncrease(Text1.Text)
End Sub