Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0522: Hochzählen von alphanumerischen Werten

VB 5/6-Tipp 0522: Hochzählen von alphanumerischen Werten

 von Holger Blombach

Schwierigkeitsgrad:

Verwendete API-Aufrufe: keine

Download: Download des Beispielprojektes [2,19 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Projekt1.vbp -------------
'--------- Anfang Formular "Form1" alias form1.frm  ---------
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Textfeld "Text1"
Option Explicit



Function AlphaCountUp(StartValue As String) As String
    Dim Values As String
    Dim A As String             'Suchbuchstabe
    Dim B As String             'Ersatzbuchstabe
    Dim I As Integer            'Zähler
    Dim Position As Integer     'Position des Buchstaben im String
    On Error Goto HandleErr
    On StartValue = "-1" Goto ExitHere
    
    Values = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    StartValue = Trim$(StartValue)
    Position = Len(StartValue)
Again:
    A = Mid$(StartValue, Position, 1)
    B = InStr(1, Values, A, vbTextCompare)
    If B = Len(Values) Then
            StartValue = Left$(StartValue, Position - 1) & Left$(Values, 1) & _
                Right$(StartValue, (Len(StartValue) - Position))
            
            Position = Position - 1
            If Position = 0 Then Position = 1
        If Position = 1 Then
            A = Mid$(StartValue, Position, 1)
            B = InStr(1, Values, A, vbTextCompare)
            If B = Len(Values) Then
                If Left$(Values, 1) = "0" Then
                    StartValue = "10" & Mid$(StartValue, 2)
                Else
                    StartValue = Left$(Values, 1) & Left$(Values, 1) & Mid$(StartValue, 2)
                End If
            Else
                StartValue = Mid$(Values, B + 1, 1) & Mid$(StartValue, 2)
            End If
        Else
            Goto Again:
        End If
    Else
        StartValue = Left(StartValue, Position - 1) & Mid$(Values, B + 1, 1)
    End If

    AlphaCountUp = StartValue
ExitHere:
    Exit Function

Error:
    MsgBox "Der an die Funktion übermittelte String enthält einen ungültigen Buchstaben!", _
        vbCritical, "Datenfehler"
        
    AlphaCountUp = -1
    Exit Function
HandleErr:
    MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical
    AlphaCountUp = -1
End Function

Private Sub Command1_Click()
  Text1 = AlphaCountUp(Text1)
End Sub

Private Sub Form_Load()
  Text1 = "Y7"
End Sub
'---------- Ende Formular "Form1" alias form1.frm  ----------
'-------------- Ende Projektdatei Projekt1.vbp --------------

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 2 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.