vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#

https://www.vbarchiv.net
Rubrik: Variablen/Strings · String-Operationen   |   VB-Versionen: VB4, VB5, VB607.02.02
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 WillBewertung:  Views:  22.238 
www.gays-about.deSystem:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 Beispielprojekt auf CD 

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



Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
 
Copyright ©2000-2024 vb@rchiv Dieter OtterAlle Rechte vorbehalten.


Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.