Live-Forum - Die aktuellen Beiträge
Datum
Titel
26.04.2024 16:22:47
Aktualisierung Verknüpfung bei geschlossener Quelldatei
26.04.2024 16:05:28
PivotChart-Stapeldiagramm erstellen
26.04.2024 15:34:42
Überlagernde Textbox-Ansicht
26.04.2024 15:27:20
Excel öffnet nach Auswahl einer Excel diese leer
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1268to1272
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1268to1272
1268to1272
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

String prüfen

String prüfen
Alifa
Hallo,
ich habe eine 5-stellige Zahl. Nur die Ziffern 1,2,3 sind erlaubt. Also sind zwei Ziffern doppelt vorhanden. Die doppelten sollen nebeneinander stehen. Beispiel: 12313 ist FALSCH. 11223 ist WAHR. Ebenso 33122, 22133.
Habe mit Len und InStr versucht. Leider klappt es nicht. Kann mir jemand helfen? Danke im Voraus
Alifa

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: String prüfen
16.07.2012 20:57:33
Reinhard
Hallo Alifa, 

Option Explicit
Sub test()
MsgBox doppelt1(12313)
MsgBox doppelt1(12233)
MsgBox doppelt1(22133)
MsgBox doppelt2(12313)
MsgBox doppelt2(12233)
MsgBox doppelt2(22133)
End Sub
Function doppelt1(x) As Boolean
Dim N, z
For N = 11 To 33 Step 11
While InStr(x, N)
x = Replace(x, N, 1, 1)
z = z + 1
Wend
Next N
If z = 2 Then doppelt1 = True
End Function
Function doppelt2(ByVal x) As Boolean
Dim N, z
For N = 11 To 33 Step 11
x = Replace(x, N, "")
Next N
If Len(x) = 1 Then doppelt2 = True
End Function

Gruß
Reinhard
AW: String prüfen
16.07.2012 21:57:24
Alifa
Hallo Reinhard,
also 11111 ist FALSCH. Hatte das leider nicht präzis genug formuliert. Alle 3 Ziffern müssen im String enthalten sein!
Gruß, Alifa
Anzeige
AW: String prüfen
16.07.2012 23:32:06
Reinhard
Hallo Alifa,
vielleicht so, seltsamerweise ? ist 11111 in beiden Funktionen False. 
Sub test()
MsgBox doppelt1(12313)
MsgBox doppelt1(12233)
MsgBox doppelt1(22133)
MsgBox doppelt1(11111)
MsgBox doppelt2(12313)
MsgBox doppelt2(12233)
MsgBox doppelt2(22133)
MsgBox doppelt2(11111)
End Sub
Function doppelt1(x) As Boolean
Dim N, z
For N = 11 To 33 Step 11
While InStr(x, N)
x = Replace(x, N, 1, 1)
z = z + 1
Wend
Next N
If z = 2 Then doppelt1 = True
End Function
Function doppelt2(ByVal z) As Boolean
Dim N, x
x = z
For N = 11 To 33 Step 11
x = Replace(x, N, "")
Next N
If Len(x) = 1 And InStr(z, 1) > 0 And InStr(z, 2) > 0 And InStr(z, 3) > 0 Then doppelt2 = True
End Function

Gruß
Reinhard
Anzeige
AW: String prüfen
17.07.2012 05:46:45
Alifa
Hallo,
das mit 11111 stimmt, tatsächlich. Aber:doppelt1 gibt 11113 WAHR und doppelt2 erkennt 21123 als WAHR.
Beim ersten Durchlauf wird die 11 "Replaced", beim zweiten gibt es dann die 22 und alles ist "OK". Ich sehe, Erich hatte Nachtschicht. Ich werde jetzt seinen Vorschlag näher betrachten.
Gruß, Erhard
AW: String prüfen
17.07.2012 01:29:21
Erich
Hi Ihr beiden,
hier noch zwei Varianten und ein paar Vergleiche: 

Option Explicit
Sub test2()
Dim w As Long
w = 12313
MsgBox w & " / " & DreiIn5(w) & " / " & TriIn5(w) & " / " & doppelt1(w) & " / " & doppelt2(w)
w = 22133
MsgBox w & " / " & DreiIn5(w) & " / " & TriIn5(w) & " / " & doppelt1(w) & " / " & doppelt2(w)
w = 22333
MsgBox w & " / " & DreiIn5(w) & " / " & TriIn5(w) & " / " & doppelt1(w) & " / " & doppelt2(w)
w = 11123
MsgBox w & " / " & DreiIn5(w) & " / " & TriIn5(w) & " / " & doppelt1(w) & " / " & doppelt2(w)
End Sub
Function DreiIn5(ByVal lngZ As Long) As Boolean
Dim ii As Integer, qu(5) As Integer, ar(3) As Integer, anz(3) As Integer
For ii = 1 To 5
qu(ii) = Fix(lngZ / 10 ^ (5 - ii))
lngZ = lngZ - 10 ^ (5 - ii) * qu(ii)
Next ii
For ii = 1 To 5
If ar(qu(ii)) > 0 And (Abs(ar(qu(ii)) - ii)) > 1 Then Exit Function
ar(qu(ii)) = ii
If anz(qu(ii)) > 1 Then Exit Function
anz(qu(ii)) = anz(qu(ii)) + 1
Next ii
If ar(1) * ar(2) * ar(3) = 0 Then Exit Function
DreiIn5 = True
End Function
Function TriIn5(ByVal lngZ As Long) As Boolean
Dim ii As Integer, ar(3) As Integer, anz(3) As Integer
For ii = 1 To 5
If anz(Mid(lngZ, ii, 1)) > 1 Then Exit Function
anz(Mid(lngZ, ii, 1)) = anz(Mid(lngZ, ii, 1)) + 1
If ar(Mid(lngZ, ii, 1)) > 0 And _
Abs(ar(Mid(lngZ, ii, 1)) - ii) > 1 Then Exit Function
ar(Mid(lngZ, ii, 1)) = ii
Next ii
If ar(1) * ar(2) * ar(3) = 0 Then Exit Function
TriIn5 = True
End Function
Function doppelt1(ByVal x) As Boolean
Dim N, z
For N = 11 To 33 Step 11
While InStr(x, N)
x = Replace(x, N, 1, 1)
z = z + 1
Wend
Next N
If z = 2 Then doppelt1 = True
End Function
Function doppelt2(ByVal z) As Boolean
Dim N, x
x = z
For N = 11 To 33 Step 11
x = Replace(x, N, "")
Next N
If Len(x) = 1 And InStr(z, 1) > 0 And InStr(z, 2) > 0 _
And InStr(z, 3) > 0 Then doppelt2 = True
End Function
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich
Anzeige
AW: String prüfen
17.07.2012 08:47:53
Alifa
Hallo Erich,
ich habe noch eine Variante gefunden. Leider löst das mein Problem nicht. Wahrscheinlich ist es so: Die Zahl enthält jede Ziffer 1,2,3. Die Zahl könnte auch so WAHR sein: 11123 oder 32221.... Ich will jetzt versuchen, eine Funktion in diesem Sinne zu finden. WAHR bleibt wie vor, 11223,22311.....also gleiche Ziffern stehen direkt nebeneinander. 

Sub test3()
Dim w As Long
w = 11113
MsgBox w & " / " & DreiIn5(w) & " / " & TriIn5(w) & " / " & Tre(w)
w = 22133
MsgBox w & " / " & DreiIn5(w) & " / " & TriIn5(w) & " / " & Tre(w)
w = 22333
MsgBox w & " / " & DreiIn5(w) & " / " & TriIn5(w) & " / " & Tre(w)
w = 11123
MsgBox w & " / " & DreiIn5(w) & " / " & TriIn5(w) & " / " & Tre(w)
End Sub
Function DreiIn5(ByVal lngZ As Long) As Boolean
Dim ii As Integer, qu(5) As Integer, ar(3) As Integer, anz(3) As Integer
For ii = 1 To 5
qu(ii) = Fix(lngZ / 10 ^ (5 - ii))
lngZ = lngZ - 10 ^ (5 - ii) * qu(ii)
Next ii
For ii = 1 To 5
If ar(qu(ii)) > 0 And (Abs(ar(qu(ii)) - ii)) > 1 Then Exit Function
ar(qu(ii)) = ii
If anz(qu(ii)) > 1 Then Exit Function
anz(qu(ii)) = anz(qu(ii)) + 1
Next ii
If ar(1) * ar(2) * ar(3) = 0 Then Exit Function
DreiIn5 = True
End Function
Function TriIn5(ByVal lngZ As Long) As Boolean
Dim ii As Integer, ar(3) As Integer, anz(3) As Integer
For ii = 1 To 5
If anz(Mid(lngZ, ii, 1)) > 1 Then Exit Function
anz(Mid(lngZ, ii, 1)) = anz(Mid(lngZ, ii, 1)) + 1
If ar(Mid(lngZ, ii, 1)) > 0 And _
Abs(ar(Mid(lngZ, ii, 1)) - ii) > 1 Then Exit Function
ar(Mid(lngZ, ii, 1)) = ii
Next ii
If ar(1) * ar(2) * ar(3) = 0 Then Exit Function
TriIn5 = True
End Function
Function Tre(ByVal z As Long) As Boolean
Dim q$
q = CStr(z)
If InStr(q, 1)  0 And InStr(q, 2)  0 And InStr(q, 3)  0 Then
If (InStr(q, 11)  0 And InStr(q, 22)  0) Or _
(InStr(q, 11)  0 And InStr(q, 33)  0) Or _
(InStr(q, 33)  0 And InStr(q, 22)  0) Then
Tre = True
End If: End If
End Function

Anzeige
weniger streng
17.07.2012 09:23:31
Erich
Hi Erhard,
wenn ich das recht verstehe, braucht man in meinen Rooutinen nur die Teile mit anz() wegzulassen.
Ich habe Testeingabe und Ausgabe mal ins Tabellenblatt verlagert: 

Sub test4()
Dim w As Long, zz As Long
For zz = 2 To 8
w = Cells(zz, 1)
Cells(zz, 2) = DreiIn5(w)
Cells(zz, 3) = TriIn5(w)
Cells(zz, 4) = Tre(w)
Next zz
End Sub
Function DreiIn5(ByVal lngZ As Long) As Boolean
Dim ii As Integer, qu(5) As Integer, ar(3) As Integer ', anz(3) As Integer
For ii = 1 To 5
qu(ii) = Fix(lngZ / 10 ^ (5 - ii))
lngZ = lngZ - 10 ^ (5 - ii) * qu(ii)
Next ii
For ii = 1 To 5
If ar(qu(ii)) > 0 And (Abs(ar(qu(ii)) - ii)) > 1 Then Exit Function
ar(qu(ii)) = ii
'     If anz(qu(ii)) > 1 Then Exit Function
'     anz(qu(ii)) = anz(qu(ii)) + 1
Next ii
If ar(1) * ar(2) * ar(3) = 0 Then Exit Function
DreiIn5 = True
End Function
Function TriIn5(ByVal lngZ As Long) As Boolean
Dim ii As Integer, ar(3) As Integer ', anz(3) As Integer
For ii = 1 To 5
'      If anz(Mid(lngZ, ii, 1)) > 1 Then Exit Function
'      anz(Mid(lngZ, ii, 1)) = anz(Mid(lngZ, ii, 1)) + 1
If ar(Mid(lngZ, ii, 1)) > 0 And _
Abs(ar(Mid(lngZ, ii, 1)) - ii) > 1 Then Exit Function
ar(Mid(lngZ, ii, 1)) = ii
Next ii
If ar(1) * ar(2) * ar(3) = 0 Then Exit Function
TriIn5 = True
End Function
Function Tre(ByVal z As Long) As Boolean
Dim q$
q = CStr(z)
If InStr(q, 1)  0 And InStr(q, 2)  0 And InStr(q, 3)  0 Then
If (InStr(q, 11)  0 And InStr(q, 22)  0) Or _
(InStr(q, 11)  0 And InStr(q, 33)  0) Or _
(InStr(q, 33)  0 And InStr(q, 22)  0) Then
Tre = True
End If: End If
End Function
Das kommt jetzt dabei raus:
 ABCD
1ZahlErg1Erg2Erg3
222332FALSCHFALSCHFALSCH
311113FALSCHFALSCHFALSCH
421123FALSCHFALSCHFALSCH
522333FALSCHFALSCHFALSCH
611123WAHRWAHRFALSCH
733122WAHRWAHRWAHR
832221WAHRWAHRFALSCH

Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich
Anzeige
weniger streng - 2. Versuch
17.07.2012 09:38:33
Erich
Hi Erhard,
bei meinen Routinen klemmte es noch, wenn z. B. 0 oder 4 als Ziffer vorkommt.
Neue Version: 

Sub test4()
Dim w As Long, zz As Long
For zz = 2 To 9
w = Cells(zz, 1)
Cells(zz, 2) = DreiIn5(w)
Cells(zz, 3) = TriIn5(w)
Cells(zz, 4) = Tre(w)
Next zz
End Sub
Function DreiIn5(ByVal lngZ As Long) As Boolean
Dim ii As Integer, qu(5) As Integer, ar(3) As Integer
For ii = 1 To 5
qu(ii) = Fix(lngZ / 10 ^ (5 - ii))
If qu(ii)  3 Then Exit Function
lngZ = lngZ - 10 ^ (5 - ii) * qu(ii)
Next ii
For ii = 1 To 5
If ar(qu(ii)) > 0 And (Abs(ar(qu(ii)) - ii)) > 1 Then Exit Function
ar(qu(ii)) = ii
Next ii
If ar(1) * ar(2) * ar(3) = 0 Then Exit Function
DreiIn5 = True
End Function
Function TriIn5(ByVal lngZ As Long) As Boolean
Dim ii As Integer, ar(3) As Integer
For ii = 1 To 5
If Mid(lngZ, ii, 1)  "3" Then Exit Function
If ar(Mid(lngZ, ii, 1)) > 0 And _
Abs(ar(Mid(lngZ, ii, 1)) - ii) > 1 Then Exit Function
ar(Mid(lngZ, ii, 1)) = ii
Next ii
If ar(1) * ar(2) * ar(3) = 0 Then Exit Function
TriIn5 = True
End Function
Function Tre(ByVal z As Long) As Boolean
Dim q$
q = CStr(z)
If InStr(q, 1)  0 And InStr(q, 2)  0 And InStr(q, 3)  0 Then
If (InStr(q, 11)  0 And InStr(q, 22)  0) Or _
(InStr(q, 11)  0 And InStr(q, 33)  0) Or _
(InStr(q, 33)  0 And InStr(q, 22)  0) Then
Tre = True
End If
End If
End Function
Und das Ergebnis:
 ABCD
1ZahlErg1Erg2Erg3
210223FALSCHFALSCHFALSCH
312433FALSCHFALSCHFALSCH
422222FALSCHFALSCHFALSCH
522332FALSCHFALSCHFALSCH
622333FALSCHFALSCHFALSCH
711123WAHRWAHRFALSCH
832221WAHRWAHRFALSCH
933122WAHRWAHRWAHR

Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich
Anzeige
AW: weniger streng - 2. Versuch
17.07.2012 10:27:17
Alifa
Hallo Erich,
mit dieser Funktion und einer Quersummenroutine konnte ich das Problem lösen. Jetzt steigert sich das auf 6,7 und 8 Ziffern, wobei das Grundprinzip erhalten bleibt. Es kommen dann (1,2,3,4), (1,2,3,4,5), bzw (1,2,3,4,5,6) zum Einsatz. Im letzten Fall ist z.B. 12345666 WAHR. Also bei der 8-stelligen Zahl werden die Ziffern 1 bis 6 verwendet. Danke für die Hilfe!
Gruß, Erhard 

Function Tre(ByVal z As Long) As Boolean
Dim q$
q = CStr(z)
If InStr(q, 1)  0 And InStr(q, 2)  0 And InStr(q, 3)  0 Then
If (InStr(q, 11)  0 And InStr(q, 22)  0) Or _
(InStr(q, 11)  0 And InStr(q, 33)  0) Or _
(InStr(q, 33)  0 And InStr(q, 22)  0) Or _
(InStr(q, 111)  0 And Quers(q) = 8) Or _
(InStr(q, 222)  0 And Quers(q) = 10) Or _
(InStr(q, 333)  0 And Quers(q) = 12) Then
Tre = True
End If: End If
End Function

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige