Hallo Tester96,

willst du nicht auch selbst Hand anlegen?

Hier mal  eine mögliche Anpassung, dass 'x' 2 mal vorkommt und jede Ziffer nur 1 mal.

Public Function testeString(ByRef s As String) As Boolean
' testet s auf Gültigkeit:
'    der String muss die Länge 9 haben
'    der String darf ausschließlich die Buchstaben [1234567x] beinhalten
'    aufeinanderfolgende Ziffern müssen aufsteigend sein
'    es müssen alle Ziffern von 1 bis 7 vorhanden sein
'    jede Ziffer darf nur 1 mal vorkommen, x kommt 2 mal vor
Dim i As Long, letzteZiffer As Long
Dim schar As String, lchar As Long, countx As Long
Dim ZifferVorhanden(1 To 7) As Boolean
 
testeString = False
 
If Not Len(s) = 9 Then Exit Function
 
countx = 0
letzteZiffer = 0
For i = 1 To 7:   ZifferVorhanden(i) = False:   Next
For i = 1 To 9
    schar = Mid(s, i, 1)
 
    If schar = "x" Then
        letzteZiffer = 0
        countx = countx + 1
        If countx > 2 Then Exit Function                    ' x muss 2 mal vorkommen
 
    ElseIf InStr("1234567", schar) Then
        lchar = CLng(schar)
        If lchar < letzteZiffer Then Exit Function          ' Ziffer größer als vorherige
        letzteZiffer = lchar
        If ZifferVorhanden(lchar) Then Exit Function        ' Jede Ziffer nur 1 mal
        ZifferVorhanden(lchar) = True
 
    Else
        Exit Function
 
    End If
Next
 
For i = 1 To 7
    If Not ZifferVorhanden(i) Then Exit Function            ' Ziffer ist nicht vorgekommen
Next
 
testeString = True
 
End Function

Man kann das sicherlich verdichten, dazu bin ich aber gerade zu faul :-).

Hier ein Test-Makro, mit den Beispielen, die mir bisher in diesem Thread über den Weg gelaufen sind:

Sub test()
Dim richtige, falsche, aktuelles, tests_bestanden As Boolean

richtige = Array("47x2356x1", "123x57x46", "xx1234567", "567xx1234")
falsche = Array("3x1234567", "67x123457", "12345x76x")

tests_bestanden = True
For Each aktuelles In richtige
    If Not testeString((aktuelles)) Then
        Debug.Print "Sollte eigentlich wahr sein: ", aktuelles
        tests_bestanden = False
    End If
Next
For Each aktuelles In falsche
    If testeString((aktuelles)) Then
        Debug.Print "Sollte eigentlich falsch sein: ", aktuelles
        tests_bestanden = False
    End If
Next

If tests_bestanden Then
    Debug.Print "Tests erfolgreich durchlaufen"
End If

End Sub

Dorrt kannst du einfach in diesen Zeilen

richtige = Array("47x2356x1", "123x57x46", "xx1234567", "567xx1234")
falsche = Array("3x1234567", "67x123457", "12345x76x")

weitere Strings hinzufügen zum testen. Das kann beim Programmieren sehr helfen (man programmiert so lange, bis die Funktion alle tests besteht.

Grüße, Ulrich