index zufallsbereich ohne doppelte

Question

hallo
ich möchte aus einer selbst generierten zahlenreihe (zb 2,6,8,12,16,20,26,28,30,32,34,40,42,44)
jede der zahlen zufällig in eine tabelle einfügen ich habs so weit geschafft =INDEX($A$1:$A$13;ZUFALLSBEREICH(1;14)) jedoch kommen in dieser formel dann die zahlen doppelt vor... im vba kenne ich mich gar nicht aus gibt es eine formellösung mit der wenn funktion hab ichs auch versucht jedoch ohne erfolg
bitte um hilfe

Answer 1

Füge noch direkt unter der Zeile Startzeit=Timer die Zeile timeout = False hinzu, um diesen im Fall der
Fälle zurückzusetzen, damit auch wirklich jede freie Zelle gefüllt wird.

In meinen Tests war bislang kein Timeout vorgekommen, aber es könnte ja sein, dass es bei dir anders ist.

Gruß Mr. K.

Answer 2

hey ich komm mir schon blöd vor^^
es funktioniert zum teil... hin und wieder werden in eine zeile doppelte zahlen eingetragen zb wurde bei mir jetzt b17 und c17 mit der zahl 16 gefüllt
und wenn ich eine komplette zeile lösche kommen immer wieder die gleichen zahlen also nicht mehr zufällig sondern die niedrigsten 3..

lg ex

Answer 3

Dann erklär doch bitte nochmal ganz genau, was du eigentlich erreichen willst. So wie es im Moment klingt
willst du jetzt auch noch keine doppelten Werte innerhalb einer Zeile sehen.

Das Makro kann man auf zweierlei Wegen aufbauen: Entweder man durchläuft jede einzelen Zelle, wählt per
Zufall eine der Zahlen aus, prüft ob diese passt und trägt sie ein - dann springt man zur nächsten Zelle. Das
hat jedoch zur Folge, dass die verschiedenen Zahlen unterschiedlich oft vorkommen.

Oder man versucht "jede der zahlen zufällig in eine tabelle" einzufügen wie du es in deiner Ausgangsfrage
beschrieben hast. Dafür Durchläuft man alle Zahlen von klein nach groß und wählt die Zielzelle im Bereich per
Zufall aus, prüft ob die Zahl dort passt, wenn nicht wird eine neue Zielzelle gewählt bis die Zahl eingetragen
werden kann. Vorteil hier: Jede der Zahlen wird gleich oft eingetragen. Also mit jedem Durchlauf genau 1 mal.

Genau das macht mein Makro. Daher sind nach Löschen der Daten von nur einer Zeile dort auch nur die
kleinen Werte zu finden.

Achso. Du brauchst dir absolut nicht "blöd" vorzukommen. Es kann oft schwieriger sein, als man denkt, eine
Frage so zu stellen, damit der Andere weiß, was man will. Das passiert ständig. Also mach dir keinen Kopp :-)

Mr. K.

Answer 4

danke für dein verständniss :D

ach du ******* dachte das keine zahl in der zeile doppelt sein soll hab ich schon mal geschrieben...

ne kombination aus deinen beiden lösungsansätzen wäre ideal^^

also in den zeilen sollten keine doppelten sein, pro durchlauf auch nicht und wenn sie ca gleich oft vorkommen wäre das ein traum :D
geht das in einem makro oder bräuchte ich dann mehrere?

lg und danke für die ausgiebige hilfe
ex

Answer 5

und ist das normal wenn alle zellen ausgefüllt sind und man versehentlich zu oft das makro startet dass sich excel aufhängt?

Answer 6

ne kombination aus deinen beiden lösungsansätzen wäre ideal

Dafür hab ich eigentlich 2 Abfragen eingebaut, damit das nicht passiert. Hast du Antwort 11 umgesetzt?

ne kombination aus deinen beiden lösungsansätzen wäre ideal

Entweder alle Zahlen kommen gleich oft vor, oder alle Zahlen kommen unterschiedlich oft vor.
Hab den Code jetzt mal so umgebaut, dass für die ersten 3 Durchgänge die bisherige Variante 2 genutzt
wird und im 4. Durchgang, wenn nur noch 12 Zellen frei sind auf die Variante 1 geswitcht wird, damit nicht
nur die niedrigsten genommen werden, sondern eine Auswahl getroffen wird.

Du brauchst jetzt nur noch einmal starten um alle Zellen zu füllen!

Sub ZahlenVerteilen()

Werte = Array(2, 6, 8, 12, 16, 20, 26, 28, 30, 32, 34, 40, 42, 44)

Set Zielbereich = Range("B4:D21")

If Zielbereich.Cells.Count < UBound(Werte) Then
MsgBox "Zielbereich ist zu klein um alle Werte zu verteilen"
Exit Sub
End If

Randomize Timer
For x = 1 To Int(Zielbereich.Count / (UBound(Werte) + 1))

For w = 0 To UBound(Werte)
startzeit = Timer
timeout = False

Do
setzen = True

z = Int(Rnd * Zielbereich.Rows.Count) + 1 'Zeile berechnen
s = Int(Rnd * Zielbereich.Columns.Count) + 1 'Spalte Berechnen

If Application.WorksheetFunction.Count(Zielbereich) _
= Zielbereich.Count Then Exit Sub 'Prüfung ob noch freie Zellen vorh.

Select Case z
Case 1 To 5 'nicht 0-9 bzw. 0-9|10-19, 0-9|20-29 usw.
If Int(Werte(w) / 10) = 0 Or Int(Werte(w) / 10) = z - 1 Then setzen = False
Case 6 To 9 'nicht 10-19 bzw. 10-19|20-29, 10-19|30-39 usw.
If Int(Werte(w) / 10) = 1 Or Int(Werte(w) / 10) = z - 5 Then setzen = False
Case 10 To 12 'nicht 20-29 bzw. 20-29|30-39, 20-29|40-45
If Int(Werte(w) / 10) = 2 Or Int(Werte(w) / 10) = z - 8 Then setzen = False
Case 13 To 14 'nicht 30-39 bzw. 30-39|40-45
If Int(Werte(w) / 10) = 3 Or Int(Werte(w) / 10) = z - 10 Then setzen = False
Case 15 'nicht 40-45
If Int(Werte(w) / 10) = 4 Then setzen = False
End Select

If Application.CountIf(Zielbereich.Rows(z), Werte(w)) > 0 Then setzen = False

'wenn für 5 sek keine der gefundenen Zellen für den Wert in Frage kommt Abbruch:
If Timer >= startzeit + 5 Then timeout = True

Loop Until Zielbereich.Cells(z, s) = "" And setzen = True Or timeout

Zielbereich(z, s) = Werte(w)
Next w

Next x

Set Zielbereich2 = Zielbereich.SpecialCells(xlCellTypeBlanks)

For Each c In Zielbereich2.Cells
z = c.Row - Zielbereich.Row + 1
s = c.Column - Zielbereich.Column + 1
startzeit = Timer
timeout = False

Do
setzen = True
w = Int(Rnd * UBound(Werte))

Select Case z
Case 1 To 5 'nicht 0-9 bzw. 0-9|10-19, 0-9|20-29 usw.
If Int(Werte(w) / 10) = 0 Or Int(Werte(w) / 10) = z - 1 Then setzen = False
Case 6 To 9 'nicht 10-19 bzw. 10-19|20-29, 10-19|30-39 usw.
If Int(Werte(w) / 10) = 1 Or Int(Werte(w) / 10) = z - 5 Then setzen = False
Case 10 To 12 'nicht 20-29 bzw. 20-29|30-39, 20-29|40-45
If Int(Werte(w) / 10) = 2 Or Int(Werte(w) / 10) = z - 8 Then setzen = False
Case 13 To 14 'nicht 30-39 bzw. 30-39|40-45
If Int(Werte(w) / 10) = 3 Or Int(Werte(w) / 10) = z - 10 Then setzen = False
Case 15 'nicht 40-45
If Int(Werte(w) / 10) = 4 Then setzen = False
End Select

If Application.CountIf(Zielbereich.Rows(z), Werte(w)) > 0 Then setzen = False

'wenn für 5 sek kein gültiger Wert gefunden wurde dann Abbruch
If Timer >= startzeit + 5 Then timeout = True


Loop Until setzen = True Or timeout

Zielbereich(z, s) = Werte(w)
Next c

End Sub

Um Alles nach Variante 1 zu füllen und gleichzeitig eine nur annähernd gleiche Verteilung zu erreichen, hast
du nicht genügend Zellen zur Verfügung. Würdest du jedoch tausende von Zeilen füllen, würdest du eine
gewisse Regelmäßigkeit in der Zahlenwiederholung feststellen, die sich aus der gleichmäßigen Taktrate
deiner Windows-Uhr (Timer) begründet. Leider fehlt mir das Wissen um den Code eine Gaußsche
Normalverteilung beizubringen. Ich war zwar nie schlecht in Mathe, aber studiert hab ich das Fach nicht.
Kannst ja trotzdem mal nach Variante 1 probieren.

Sub ZahlenVerteilen_Var1()

Werte = Array(2, 6, 8, 12, 16, 20, 26, 28, 30, 32, 34, 40, 42, 44)

Set Zielbereich = Range("B4:D21")

If Zielbereich.Cells.Count < UBound(Werte) Then
MsgBox "Zielbereich ist zu klein um alle Werte zu verteilen"
Exit Sub
End If

Randomize Timer

For Each c In Zielbereich.Cells
z = c.Row - Zielbereich.Row + 1
s = c.Column - Zielbereich.Column + 1
startzeit = Timer
timeout = False

Do
setzen = True
w = Int(Rnd * UBound(Werte))

Select Case z
Case 1 To 5 'nicht 0-9 bzw. 0-9|10-19, 0-9|20-29 usw.
If Int(Werte(w) / 10) = 0 Or Int(Werte(w) / 10) = z - 1 Then setzen = False
Case 6 To 9 'nicht 10-19 bzw. 10-19|20-29, 10-19|30-39 usw.
If Int(Werte(w) / 10) = 1 Or Int(Werte(w) / 10) = z - 5 Then setzen = False
Case 10 To 12 'nicht 20-29 bzw. 20-29|30-39, 20-29|40-45
If Int(Werte(w) / 10) = 2 Or Int(Werte(w) / 10) = z - 8 Then setzen = False
Case 13 To 14 'nicht 30-39 bzw. 30-39|40-45
If Int(Werte(w) / 10) = 3 Or Int(Werte(w) / 10) = z - 10 Then setzen = False
Case 15 'nicht 40-45
If Int(Werte(w) / 10) = 4 Then setzen = False
End Select

If Application.CountIf(Zielbereich.Rows(z), Werte(w)) > 0 Then setzen = False

'wenn für 5 sek kein gültiger Wert gefunden wurde dann Abbruch
If Timer >= startzeit + 5 Then timeout = True


Loop Until setzen = True Or timeout
Zielbereich(z, s) = Werte(w)
Next c

End Sub

Gruß Mr. K.

Answer 7

Die Antwort auf das erste Zitat bezog sich eigentlich auf das Aufhängen von Excel, was eigentlich nicht
vorkommen dürfte, da ich hier einen Timeout sowie eine Prüfung eingebaut habe, die checkt ob alle Zellen
ausgefüllt sind. Falls du immer noch Probleme hast sag Bescheid.

Den ersten Code aus Antwort 16, musste ich nochmal überarbeiten, sonst kann es sein, dass im 4.
Durchgang in den freien Zellen doch wieder einige Werte doppelt vorkommen und andere gar nicht. Du
wolltest aber sicher, dass hier 12 verschiedene Zahlen drin stehen, stimmts?

Sub ZahlenVerteilen()

werte = Array(2, 6, 8, 12, 16, 20, 26, 28, 30, 32, 34, 40, 42, 44)

Set Zielbereich = Range("B4:D21")

If Zielbereich.Cells.Count < UBound(werte) Then
MsgBox "Zielbereich ist zu klein um alle Werte zu verteilen"
Exit Sub
End If

Randomize Timer
For x = 1 To Int(Zielbereich.Count / (UBound(werte) + 1))

For w = 0 To UBound(werte)
startzeit = Timer
timeout = False

Do
setzen = True

z = Int(Rnd * Zielbereich.Rows.Count) + 1 'Zeile berechnen
s = Int(Rnd * Zielbereich.Columns.Count) + 1 'Spalte Berechnen

If Application.WorksheetFunction.Count(Zielbereich) _
= Zielbereich.Count Then Exit Sub 'Prüfung ob noch freie Zellen vorh.

Select Case z
Case 1 To 5 'nicht 0-9 bzw. 0-9|10-19, 0-9|20-29 usw.
If Int(werte(w) / 10) = 0 Or Int(werte(w) / 10) = z - 1 Then setzen = False
Case 6 To 9 'nicht 10-19 bzw. 10-19|20-29, 10-19|30-39 usw.
If Int(werte(w) / 10) = 1 Or Int(werte(w) / 10) = z - 5 Then setzen = False
Case 10 To 12 'nicht 20-29 bzw. 20-29|30-39, 20-29|40-45
If Int(werte(w) / 10) = 2 Or Int(werte(w) / 10) = z - 8 Then setzen = False
Case 13 To 14 'nicht 30-39 bzw. 30-39|40-45
If Int(werte(w) / 10) = 3 Or Int(werte(w) / 10) = z - 10 Then setzen = False
Case 15 'nicht 40-45
If Int(werte(w) / 10) = 4 Then setzen = False
End Select

If Application.CountIf(Zielbereich.Rows(z), werte(w)) > 0 Then setzen = False

'wenn für 5 sek keine der gefundenen Zellen für den Wert in Frage kommt Abbruch:
If Timer >= startzeit + 5 Then timeout = True

Loop Until Zielbereich.Cells(z, s) = "" And setzen = True Or timeout

Zielbereich(z, s) = werte(w)
Next w

Next x

Set Zielbereich2 = Zielbereich.SpecialCells(xlCellTypeBlanks)

gezogen = ","
For Each c In Zielbereich2.Cells
z = c.Row - Zielbereich.Row + 1
s = c.Column - Zielbereich.Column + 1
startzeit = Timer
timeout = False

Do
setzen = True
w = Int(Rnd * UBound(werte))



Select Case z
Case 1 To 5 'nicht 0-9 bzw. 0-9|10-19, 0-9|20-29 usw.
If Int(werte(w) / 10) = 0 Or Int(werte(w) / 10) = z - 1 Then setzen = False
Case 6 To 9 'nicht 10-19 bzw. 10-19|20-29, 10-19|30-39 usw.
If Int(werte(w) / 10) = 1 Or Int(werte(w) / 10) = z - 5 Then setzen = False
Case 10 To 12 'nicht 20-29 bzw. 20-29|30-39, 20-29|40-45
If Int(werte(w) / 10) = 2 Or Int(werte(w) / 10) = z - 8 Then setzen = False
Case 13 To 14 'nicht 30-39 bzw. 30-39|40-45
If Int(werte(w) / 10) = 3 Or Int(werte(w) / 10) = z - 10 Then setzen = False
Case 15 'nicht 40-45
If Int(werte(w) / 10) = 4 Then setzen = False
End Select

If Application.CountIf(Zielbereich.Rows(z), werte(w)) > 0 Then setzen = False
If InStr(1, gezogen, "," & werte(w) & ",") > 0 Then setzen = False

'wenn für 5 sek kein gültiger Wert gefunden wurde dann Abbruch
If Timer >= startzeit + 5 Then timeout = True


Loop Until setzen = True Or timeout

gezogen = gezogen & werte(w) & ","
Zielbereich(z, s) = werte(w)
Next c


End Sub
Mr K.

Answer 8

hey danke :D
denke genau das ist es (beides klappt super)
nur welches makro ist jetzt welches? verstehe ich das richtig dass das längere makro das ist wo zuerst die zellen zufällig gewählt werden und da die von niedrigste bis höchste zahle eingetragen wird und ab 4.durchlauf gewechselt wird?

eine frage hab ich dann noch was müsste ich noch ändern an den makros wenn ich mehrere / weniger zahlen verwenden möchte?

reicht es wenn ich die beiden zeilen ändere?

werte = Array(2, 6, 8, 12, 16, 20, 26, 28, 30, 32, 34, 40, 42, 44)

Set Zielbereich = Range("B4:D21")

der zahlenbereich würde der gleiche bleiben

Answer 9

Hi,

das verstehst du genau richtig. Das längere Makro (in Antwort 17) durchläuft die Zahlen und wählt die Zellen
zufällig aus. Aber nur solange jeweils genauso viele Zellen frei, wie Zahlen vorhanden sind. Wenn weniger
Zellen frei sind wird geswitcht und es werden die noch freien Zellen durchlaufen un dafür eine der Zahlen
per Zufall gewählt. Das kürzere Makro im unteren Teil von Antwort 16 macht nur den zweiten Schritt, hat aber
den Nachteil, dass einige Zahlen öfter und andere vielleicht gar nicht vorkommen können.

Sowohl das Zahlenarray als auch der Zielbereich können natürlich angepasst werden. Solange die
zusätzlichen Zahlen ebenfalls zwischen 1 und 45 liegen und die zusätzlichen Zeilen im Zielbereich alle
Zahlen Ausnahme aufnehmen dürfen. Solltest du jedoch Zahlen > 49 verwenden oder zusätzliche
Bedingungen benötigen, musst du den Case-Teil im Code anpassen, der prüft, in welcher Zeile (z) die
gewählte Zelle liegt. Case 1 bedeutet dabei jedoch nicht Zeile 1 sondern die erste Zeile im Zielbereich, hier
also Zeile 4.

Da du VBA-Neuling bist, hier nochmal der Versuch einer Erklärung.
Es wird immer nur ein Case-Teil angesprochen. Das ist so eine Art Wenn-Bedingung.
Case 1 To 5 gilt z.B. dann, wenn die Zeile also die 1., 2., 3., 4. oder 5. Zeile im Zielbereich ist. Dann wird mit
werte(w) der w-te Wert aus dem Array gezogen (die erste Zahl im Array entspricht w=0, die zweite w=1
usw.), diese Zahl wird durch 10 geteilt und mit Int die Nachkommastellen abgeschnitten. das was
übrigbleibt ist die Zehnerpotenz der Zahl, die dann geprüft werden kann, ob sie gesetzt werden darf oder
nicht. im Fall von Zeile 3 wäre die durch z-1 berechnete Zehnerpotenz 2 für alle Zahlen von 20 bis 29

Ich hoffe, das ist verständlich genug. Ansonsten einfach fragen.
Viel Erfolg bei deinem Projekt - Mr. K.