Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Sechsstellige Zahlen mit VBA prüfen

Betrifft: Sechsstellige Zahlen mit VBA prüfen von: Alifa
Geschrieben am: 14.09.2014 11:02:01

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

  

Betrifft: Aufgabe unklar ... von: Matthias L
Geschrieben am: 14.09.2014 11:40:02

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


  

Betrifft: AW: Aufgabe unklar ... von: Alifa
Geschrieben am: 14.09.2014 15:06:45


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



  

Betrifft: wenn Du meinst, soll es eben so sein von: Matthias L
Geschrieben am: 14.09.2014 15:23:58

Hallo (Begrüßung)

Beitragstext:
118577
158371
Das sind DREI (3!)

Ich bin dann raus

Gruß Matthias (ein netter Gruß am Ende)


  

Betrifft: AW: Aufgabe unklar ... von: {Boris}
Geschrieben am: 14.09.2014 15:57:30

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


  

Betrifft: AW: Sechsstellige Zahlen mit VBA prüfen von: Alifa
Geschrieben am: 14.09.2014 18:07:41

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


  

Betrifft: AW: Sechsstellige Zahlen mit VBA prüfen von: Daniel
Geschrieben am: 14.09.2014 22:12:14

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


  

Betrifft: AW: Sechsstellige Zahlen mit VBA prüfen von: Alifa
Geschrieben am: 15.09.2014 08:34:31

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


  

Betrifft: AW: Sechsstellige Zahlen mit VBA prüfen von: Daniel
Geschrieben am: 15.09.2014 08:57:28

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


  

Betrifft: AW: Sechsstellige Zahlen mit VBA prüfen von: Alifa
Geschrieben am: 15.09.2014 21:51:44

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


  

Betrifft: AW: Sechsstellige Zahlen mit VBA prüfen von: Daniel
Geschrieben am: 15.09.2014 23:20:17

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



  

Betrifft: AW: Sechsstellige Zahlen mit VBA prüfen von: Alifa
Geschrieben am: 16.09.2014 08:57:26

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



  

Betrifft: AW: Sechsstellige Zahlen mit VBA prüfen von: Daniel
Geschrieben am: 16.09.2014 11:49:53

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


  

Betrifft: Sechsstellige Zahlen mit VBA prüfen von: Erich G.
Geschrieben am: 15.09.2014 00:21:03

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!


  

Betrifft: AW: Sechsstellige Zahlen mit VBA prüfen von: Alifa
Geschrieben am: 15.09.2014 09:15:50

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


  

Betrifft: AW: Sechsstellige Zahlen mit VBA prüfen von: Alifa
Geschrieben am: 16.09.2014 14:05:17

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


 

Beiträge aus den Excel-Beispielen zum Thema "Sechsstellige Zahlen mit VBA prüfen"