Sub Ziehung4ZahlenOhneRedundanzen()
'Simulation einer Ziehung von 20 nichtreundanten vierstelligen Zahlen
'Ziehung von 4 unterschiedlichen Zahlen aus diesen 20 Zahlen
'bis die Summe der jeweils ersten Stelle der 4 Zahlen 10 ergibt
'24.03.2010, NoNet - www.excelei.de
Dim arrZ4(0 To 9999), arrZahlen(1 To 20), arrZ(1 To 4)
Dim lngT As Long, lngZ As Long, strZ As String
Do
'zunächst 20 Zahlen ohne doppelt eaus den 9999 Zahlen "ziehen" :
For lngT = 1 To 20
Do
Randomize Timer
arrZahlen(lngT) = Int(Rnd() * 9999) + 1
Loop Until Not arrZ4(arrZahlen(lngT))
'Gezogene Zahl auf 1 setzen um Redundanzen zu vermeiden :
arrZ4(arrZahlen(lngT)) = 1
Next
lngZ = Cells(Rows.Count, 1).End(xlUp).Row + 1
For lngT = 1 To 20
'Zahlenarray wieder auf 0 setzen :
arrZ4(arrZahlen(lngT)) = 0
Next
'Jetzt aus den 20 möglichen Zahlen 4 Zahlen ohne doppelte "ziehen" :
For lngT = 1 To 4
Do
arrZ(lngT) = arrZahlen(Int(Rnd() * 20) + 1)
Loop Until arrZ4(arrZ(lngT)) = 0
'Gezogene Zahl auf 1 setzen um Redundanzen zu vermeiden :
arrZ4(arrZ(lngT)) = 1
Next
lngZ = 0
For lngT = 1 To 4
'Zahlenarray wieder auf 0 setzen :
arrZ4(arrZ(lngT)) = 0
'Summe der ersten Ziffer der 4 gezogenen Zahlen ermitteln :
lngZ = lngZ + Val(Left(Format(arrZ(lngT), "0000"), 1))
Next
Loop Until lngZ = 10 'wiederholen, bis die Summe der ersten Ziffer 10 ergibt
lngZ = Cells(Rows.Count, 1).End(xlUp).Row + 1
'20 mögliche Zahlen in Tabelle ausgeben :
For lngT = 1 To 20
Cells(lngZ, lngT + 6) = arrZahlen(lngT)
Next
Cells(lngZ, 7).Resize(, 20).NumberFormat = "0000"
'4 gezogene Zahlen in Tabelle ausgeben :
For lngT = 1 To 4
Cells(lngZ, lngT) = arrZ(lngT)
strZ = strZ & Format(arrZ(lngT), "0000") & vbLf
Next
Cells(lngZ, 1).Resize(, 4).NumberFormat = "0000"
'MATRIX-Funktionen zum Überprüfen der Anzahl unterschiedlicher Zahlen :
Cells(lngZ, 5).FormulaArray = "=SUM(1/COUNTIF(RC[-4]:RC[-1],RC[-4]:RC[-1]))"
Cells(lngZ, 27).FormulaArray = "=SUM(1/COUNTIF(RC[-20]:RC[-1],RC[-20]:RC[-1]))"
Columns("A:AA").AutoFit
'Speicher für ARRAYs wieder freigeben :
Erase arrZ4
Erase arrZahlen
Erase arrZ
MsgBox "Es wurden folgende 4 Zahlen gezogen, deren erste Stelle " & _
"die Summe 10 ergibt :" & vbLf & vbLf & strZ, _
vbOKOnly + vbInformation, "Gezogene Zahlen"
End Sub
Es könnte also auch 0001,1234,8888,1111 gezogen werden, da deren erste Stellen in der Summe auch 10 ergeben !
Gruß, NoNet
AW: Ziehung 4 aus 20 vierstelligen Zahlen
alifa
Hallo NoNet,
Zunächst danke für Dein Makro. Das war ein Beispiel. Ich kann darauf mein "wirkliches" Problem nicht aufbauen. Mein Array ist folgendes:
a = Array(145236, 162435, 163254, 213465, 236145, _
243516, 256431, 261534, 312564, 325416, 342615, _
346521, 351624, 361452, 416325, 431256, 521346, 624351)
Das sind 18 sechsstellige Zahlen. Es sollen je 6 gezogen werden. Die Bedingung: Die 6 Zahlen untereinander geschrieben sollen: jede Zeile vorwärts und rückwärts gelesen aus ALLEN Ziffern von 1 bis 6 bestehen UND durch 7 restlos teilbar sein. Das Gleiche gilt für die 6 Spalten des 6x6 Quadrates.
Das Makro soll ziehen und ziehen...bis das Gesuchte gefunden wurde. Ich hoffe, es gibt eine Lösung!
Seit einer Woche kriege ich das Problem nicht in den Griff! Ich denke, es ist schwierig...
Gruß, Erhard
AW: Ziehung 4 aus 20 vierstelligen Zahlen
Michael
mh,
die Zahlen sind doch IMMER durch 7 teilbar, egal welche Du nimmt. Wenn ich mich recht an meine Schulzeit erinnere (ist schon 30 Jahre her) ist eine Zahl durch 7 teilbar wenn die Quersummer durch 7 teilbar ist, und das trifft auf die Zahlen von 1 bis 6 zu das ergibt IMMER 21. Also erstes Problem gelöst.
Was ist das überhaupt für eine Aufgabe (nur mal intessehalber gefragt).
Das sieht für mich wie eine Hausaufgabe aus? Oder machst Du das Freiwillig :-)
@Michael : Du verwechselst wohl 7 mit 3 oder 9
NoNet
Hallo Michael,
Auf welcher Schule warst Du denn ? Habt ihr wirklich gelernt, dass eine Zahl dann durch 7 teilbar ist, wenn deren Quersumme durch 7 teilbar ist ? - Oder verwechselst Du das etwa mit 3 und 9 ?
Nimm z.B. 123465 = Quersumme 21, aber 123465 / 7 = 17637,85714 (Ok : "teilbar" ist sie schon durch 7, aber eben nicht ganzzahlig bzw. ohne Rest ;-)
Mal sehen, ob ich in 9 Jahren genauso denke, dann sind es bei mir auch 30 Jahre her... ;-)
Was ist das überhaupt für eine Aufgabe (nur mal intessehalber gefragt).
Das interessiert mich auch..
Gruß, NoNet
AW: @Michael : Du verwechselst wohl 7 mit 3 oder 9
Michael
:-( jau, das war es wohl 3 oder 9
Aber die Zahlen die er angegeben hat sind alle durch 7 teilbar, wenn ich richtig getippt habe.
Das ist ja eine komplett andere Aufgabenstellung
NoNet
Hallo Alifa,
das ärgert mich : ich denke und tippe mich hier fast wund und dann stellt sich heraus, dass die Aufgabenstellung (fast) komplett anders ist :-(
Dein "Beispiel" in der Anfrage hat kaum etwas mit dem nun hier geschilderten Sachverhalt zu tun !
Ich bin "draußen" aus dem Thread, lasse ihn aber für andere Mitdenker offen...
Gruß, NoNet
Nicht ärgern, NoNet, das ist beim...
Luc:-?
…guten Alifa-Erhard schon mal so… ;-)
Du weißt doch, was ihn umtreibt — wenn nicht, siehe hier…
Gruß Luc :-?
AW: Das ist ja eine komplett andere Aufgabenstellung
alifa
Hallo NoNet,
Du hast das Thema nicht richtig verstanden und gleich verbittert losgelegt. Warum 20 Zahlen aus 9999 ziehen? Du ziehst zweimal. Einmal die 20 Zahlen aus den 9999 und dann aus diesen die gesuchten Zahlen. Das Wort "Beispiel" besagt im allgemeinen Sprachverständnis nichts Konkretes. Du siehst, meine "wirklichen" Bedingungen sind komplexer. Ich werde jetzt versuchen, Dein Makro als Vorlage für mein Problem zu nutzen. Das ist natürlich Fleißarbeit und die will und darf ich nicht dem Forum zumuten. Übrigens, wenn Du willst, mach es mit meinen Beiträgen wie ich es mache mit Luc:? Ich beachte sie einfach nicht! Trotzdem schätze ich Deinen Beitrag zu diesem Thema. Ach so, was das soll: Freizeit und ein Faible für VBA.
Gruß, Erhard
|