Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1380to1384
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
Inhaltsverzeichnis

Sechsstellige Zahlen mit VBA prüfen

Sechsstellige Zahlen mit VBA prüfen
14.09.2014 11:02:01
Alifa
Hallo,
sechsstellige Zahlen(Ziffern 1-8) sollen mit 5 Muster-Zahlen verglichen werden. Eine
Anzahl n Ziffern sollen an gleicher Stelle stehen und eine Anzahl n1 gleiche Ziffern sollen an falscher Stelle stehen. Beispiel: Eine der 5 Muster-Zahlen m1=118577. Gesucht
die 6-stellige Zahl, bei der 3 Ziffern an richtiger Stelle stehen und 2 an falscher.
158371 ist hier WAHR. Die Ziffern 1,8,7 stehen an richtiger Stelle und 1,5 an falscher
Stelle. Leider finde ich keine Lösung für die Ziffern an falscher Stelle. Kann jemand helfen? Für die an richtiger Stelle: Function Ar(ByVal s1, s2, z1) As Boolean 'An richtiger Stelle Dim i&, n& For i = 1 To Len(s1) If Mid$(s1, i, 1) = Mid$(s2, i, 1) Then n = n + 1 Next If n z1 Then Exit Function Ar = True End Function
Gruß Alifa

15
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Aufgabe unklar ...
14.09.2014 11:40:02
Matthias
Hallo
Wiso sind 2 falsch?
118577
158371
Sind das nicht 3 ?


 ABCDEFGH
1Muster      
2118577158371      
3Pos 1Pos 2Pos 3Pos 4Pos 5Pos 6WAHRFALSCH
4WAHRFALSCHWAHRFALSCHWAHRFALSCH33

Formeln der Tabelle
ZelleFormel
A4=TEIL($A$2;SPALTE();1)=TEIL($B$2;SPALTE();1)
B4=TEIL($A$2;SPALTE();1)=TEIL($B$2;SPALTE();1)
C4=TEIL($A$2;SPALTE();1)=TEIL($B$2;SPALTE();1)
D4=TEIL($A$2;SPALTE();1)=TEIL($B$2;SPALTE();1)
E4=TEIL($A$2;SPALTE();1)=TEIL($B$2;SPALTE();1)
F4=TEIL($A$2;SPALTE();1)=TEIL($B$2;SPALTE();1)
G4=ZÄHLENWENN($A$4:$F$4;G$3)
H4=ZÄHLENWENN($A$4:$F$4;H$3)


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4
Gruß Matthias

Anzeige
AW: Aufgabe unklar ...
14.09.2014 15:06:45
Alifa

Muster: 118577   -1-5-7
Suchen: 158371   -5-3-1    es sind 2 an falscher Stelle

wenn Du meinst, soll es eben so sein
14.09.2014 15:23:58
Matthias
Hallo (Begrüßung)
Beitragstext:
118577
158371
Das sind DREI (3!)
Ich bin dann raus
Gruß Matthias (ein netter Gruß am Ende)

AW: Aufgabe unklar ...
14.09.2014 15:57:30
{Boris}
Hi,
Muster in A1, Suchen in A2.
=SUMMENPRODUKT(N(TEIL(A1;SPALTE(1:1);1)TEIL(A2;SPALTE(1:1);1)))
Ergibt aber in Deinem Beispiel in der Tat (logischerweise) 3.
VG, Boris

Anzeige
AW: Sechsstellige Zahlen mit VBA prüfen
14.09.2014 18:07:41
Alifa
Hallo Boris,
wenn man von beiden Zahlen, die 3 Ziffern, die an richtiger Position stehen, löscht, verbleiben Muster:
-1-5-7 und Gesuchte -5-3-1, also 2 gemeinsame Ziffern(5 und 1). Das Ganze ist etwas verwirrend, wegen der doppelten Ziffern. Matthias bitte ich um Nachsicht. Vielleicht kann man das auch per VBA nicht lösen.
Danke für die Beiträge!
Gruß, Alifa

AW: Sechsstellige Zahlen mit VBA prüfen
14.09.2014 22:12:14
Daniel
Hi
probiere mal folgende Funktion:
Function AR(ByVal s1 As String, s2 As String, Anzahl As Long, WertUndStelle As Boolean) As  _
Boolean
Dim i As Long, P As Long
Dim AnzahlWertUndStelle As Long
Dim AnzahlWert As Long
For i = 1 To Len(s1)
If Mid$(s1, i, 1) = Mid$(s2, i, 1) Then
AnzahlWertUndStelle = AnzahlWertUndStelle + 1
Mid$(s2, i, 1) = "|"
End If
Next
For i = 1 To Len(s1)
P = InStr(s2, Mid$(s1, i, 1))
If P > 0 Then
AnzahlWert = AnzahlWert + 1
Mid$(s2, i, 1) = "|"
End If
Next
If WertUndStelle Then
If AnzahlWertUndStelle = Anzahl Then AR = True
Else
If AnzahlWert = Anzahl Then AR = True
End If
End Function
ich habe einen 4. Parameter hinzugefügt
wenn dieser den Wert WAHR bekommt, überprüfst du die Anzahl "Wert und Stelle richtig"
wenn dieser den Wert FALSCH bekommt, überprüfst du die Anzal "nur Wert richtig"
Gruß Daniel

Anzeige
AW: Sechsstellige Zahlen mit VBA prüfen
15.09.2014 08:34:31
Alifa
Hi Daniel,
ich prüfe die Zahlen: For a=111111 To 188888. Meine erste(von 5) Prüfzahl p1=157188. Wenn ich in meiner Sub das eingebe:If AR(a,157188,3,True) And AR(a,157188,2,False) Then...ergibt das 1004 Lösungen. Die erste davon ist:112288. Hier stimmt "Wert und Stelle richtig", nicht aber "nur Wert richtig". Bedingung hier war:"Wert und Stelle richtig"=3 und "nur Wert richtig"=2. Oder habe ich etwas falsch verstanden?
Gruß, Erhard

AW: Sechsstellige Zahlen mit VBA prüfen
15.09.2014 08:57:28
Daniel
Hi
Probiere mal mit folgender Erweiterung
Function AR(ByVal s1 As String, s2 As String, Anzahl As Long, WertUndStelle As Boolean) As  _
Boolean
Dim i As Long, P As Long
Dim AnzahlWertUndStelle As Long
Dim AnzahlWert As Long
For i = 1 To Len(s1)
If Mid$(s1, i, 1) = Mid$(s2, i, 1) Then
AnzahlWertUndStelle = AnzahlWertUndStelle + 1
Mid$(s2, i, 1) = "|"
End If
Next
For i = 1 To Len(s1)
If Mid$(s1, i, 1)  "|" Then
P = InStr(s2, Mid$(s1, i, 1))
If P > 0 Then
AnzahlWert = AnzahlWert + 1
Mid$(s2, i, 1) = "|"
End If
End If
Next
If WertUndStelle Then
If AnzahlWertUndStelle = Anzahl Then AR = True
Else
If AnzahlWert = Anzahl Then AR = True
End If
End Function

Gruß Daniel

Anzeige
AW: Sechsstellige Zahlen mit VBA prüfen
15.09.2014 21:51:44
Alifa
Hi Daniel,
das klappt noch nicht mit "nur Wert richtig". "Wert und Stelle richtig" klappt. Ein Ansatz wäre, die Ziffern "Wert und Stelle richtig" in beiden Zahlen(Variable und Muster) zu eliminieren und den Rest testen. Leider reichen meine VBA Kenntnisse nicht soweit.
Gruß, Erhard

AW: Sechsstellige Zahlen mit VBA prüfen
15.09.2014 23:20:17
Daniel
Hi
so sollte es gehen (hier nur der zentrale Teil, weil ich Kopf und ende etwas geändert habe um besser testen zu können, deine Version ist da etwas kompliziert):
Dim i As Long, P As Long
Dim AnzahlWertUndStelle As Long
Dim AnzahlWert As Long
For i = 1 To Len(s1)
If Mid$(s1, i, 1) = Mid$(s2, i, 1) Then
AnzahlWertUndStelle = AnzahlWertUndStelle + 1
Mid$(s2, i, 1) = "|"
Mid$(s1, i, 1) = "|"
End If
Next
For i = 1 To Len(s1)
If Mid$(s1, i, 1)  "|" Then
P = InStr(s2, Mid$(s1, i, 1))
If P > 0 Then
AnzahlWert = AnzahlWert + 1
Mid$(s2, P, 1) = "|"
Mid$(s1, i, 1) = "|"
End If
End If
Next

Anzeige
AW: Sechsstellige Zahlen mit VBA prüfen
16.09.2014 08:57:26
Alifa
Hi,
ist das so gemeint?

Option Explicit
Sub Mmw4()
Dim a&
For a = 111111 To 188888
If InStr(a, 0) = 0 And InStr(a, 9) = 0 Then
If AR(a, 157188, 3, True) And AR(a, 157188, 2, False) Then _
'z = z + 1
'If z = 2000 Then Exit Sub
'Cells(z, 1) = a
MsgBox a
End If: End If:
Next
End Sub
Function AR(ByVal s1 As String, s2 As String, Anzahl As Long, WertUndStelle As Boolean) As _
Boolean
Dim i As Long, P As Long
Dim AnzahlWertUndStelle As Long
Dim AnzahlWert As Long
For i = 1 To Len(s1)
If Mid$(s1, i, 1) = Mid$(s2, i, 1) Then
AnzahlWertUndStelle = AnzahlWertUndStelle + 1
Mid$(s2, i, 1) = "|"
Mid$(s1, i, 1) = "|"
End If
Next
For i = 1 To Len(s1)
If Mid$(s1, i, 1)  "|" Then
P = InStr(s2, Mid$(s1, i, 1))
If P > 0 Then
AnzahlWert = AnzahlWert + 1
Mid$(s2, P, 1) = "|"
Mid$(s1, i, 1) = "|"
End If
End If
Next
If WertUndStelle Then
If AnzahlWert = Anzahl Then AR = True
Else
If AnzahlWert = Anzahl Then AR = True
End If
End Function

Anzeige
AW: Sechsstellige Zahlen mit VBA prüfen
16.09.2014 11:49:53
Daniel
Hi
naja, schau dir deinen letzen Teil an, in dem du ermittelten Werte an die Funktion zurück gibst, den kannst du nicht so gemeint haben, wie du ihn programmiert hast.
Gruß Daniel

Sechsstellige Zahlen mit VBA prüfen
15.09.2014 00:21:03
Erich
Hi Erhard,
vor der Bestimmung der Anzahl richtiger Ziffern an falscher Stelle ermittelt man wohl die Übereinstimmungen
mit richtiger Position. Das macht hier VglA:

Option Explicit
Sub aTst()
Dim nPos As Long, nNot As Long
VglA Cells(1, 1), Cells(2, 1), nPos, nNot
MsgBox nPos & " / " & nNot
End Sub
Sub VglA(mm As Long, nn As Long, PosOk As Long, PosNo As Long)
Dim arA, arB, ii As Long, jj As Long
arA = Lng2Arr(mm)
arB = Lng2Arr(nn)
For ii = 1 To UBound(arA)
If arA(ii) = arB(ii) Then
PosOk = PosOk + 1
arA(ii) = 0
arB(ii) = 0
End If
Next ii
For ii = 1 To UBound(arA)
If arA(ii) > 0 Then
For jj = 1 To UBound(arB)
If arA(ii) > 0 And arA(ii) = arB(jj) Then
PosNo = PosNo + 1
arA(ii) = 0
arB(jj) = 0
End If
Next jj
End If
Next ii
End Sub
Function Lng2Arr(nn)
Dim tt As String, arT(), ii As Long
tt = CStr(nn)
ReDim arT(1 To Len(tt))
For ii = 1 To Len(tt)
arT(ii) = --Mid(tt, ii, 1)
Next ii
Lng2Arr = arT
End Function
Was bedeutet, dass es gerade 5 Musterzahlen sein sollen? Warum nicht 7?
Hier und auch in deinem Code geht es jeweils nur um den Vergleich zweier Zahlen.
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich und: Eine schöne Woche allerseits!

Anzeige
AW: Sechsstellige Zahlen mit VBA prüfen
15.09.2014 09:15:50
Alifa
Hi Erich,
ich prüfe die Zahlen a von 111111 bis 188888. Vorgegeben sind 5 "Musterzahlen". Eine davon ist 157188.
Bei jeder dieser 5 Musterzahlen soll jeweils gewährleistet sein, dass die Bedingung n1 "richtige Ziffern an richtiger Position" und n2 "richtige Ziffern an falscher Position" erfüllt wird. Hier ist n1=3 und n2=2. Die Zahl a=187681, a=175288, a=112588....würde hier passen. (mit Deiner Sub getestet!) Anscheinend gibt es, in Anbetracht aller 5 "Musterzahlen", eine einzige sechsstellige Zahl als Lösung. Wenn nur mit einer "Musterzahl" getestet wird, gibt es offensichtlich mehrere Lösungen.
Gruß, Erhard

Anzeige
AW: Sechsstellige Zahlen mit VBA prüfen
16.09.2014 14:05:17
Alifa
Hi,
vielen Dank an das gute Team. Erich, Deine Prozedur konnte ich endlich halbwegs kapieren und habe sie an meine Aufgabe angepasst. Das klappt jetzt vorzüglich. Bei Daniel's Lösung bin ich noch dran.
Gruß, Erhard

303 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige