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

Hallo ex13

mit Formel ist das leider nicht möglich. Für VBA jedoch ein
Kinderspiel. Füge den folgenden Code im VBA-Editor (ALT+F11) in
ein Standardmodul (z.B. Modul1) ein.

Sub ZahlenVerteilen()

Werte = Range("A1:A14")
'oder
Werte = Array(2, 6, 8, 12, 16, 20, 26, 28, 30, 32, 34, 40, 42, 44)
'eine der beiden Zeilen reicht


Set Zielbereich = Range("C1:E13")

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

Randomize Timer
For w = 0 To UBound(Werte)
Do
z = Int(Rnd * Zielbereich.Rows.Count) + 1
s = Int(Rnd * Zielbereich.Columns.Count) + 1
If Application.WorksheetFunction.Count(Zielbereich) _
= Zielbereich.Count Then Exit Sub
Loop Until Zielbereich.Cells(z, s) = ""

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

End Sub

Du kannst die zu verteilenden Werte auf zwei verschiedene Weisen
in die Variable Werte einlesen. Die jeweils andere Zeile kannst du
löschen.

Solltest du die erste Variante Werte = Range("A1:A14") verwenden
musst du im Code For w = 0 durch For w = 1 sowie Zielbereich(z, s)
= Werte(w) durch Zielbereich(z, s) = Werte(w, 1) ersetzen.

Den Zielbereich musst du natürlich noch an deine Wünsche
anpassen.

Gruß Mr. K.

Answer 2

Leider ist hierfür wirklich nur eine VBA-Lösung möglich. Falls du
Fragen hast meld' dich einfach.

Answer 3

super danke für die schnelle hilfe
hat gleich auf anhieb geklappt :D

Answer 4

hey nochmal hab ne zusätzliche frage
wenn ich jetzt in der ersten reihe mit 3 zahlen keine einstellige zahl möchte in der 2ten keine 10er zahl 3. keine 20er 4. keine 30er und 5.keine 40er

weiter würde es dann gehen mit keine 0er und 10er, 0er und 20er, 0 und 30, 0und 40 dann 10 u20 usw

gibts hirfür ne lösung?

lg
ex13

Answer 5

Hallo ex13,

wenn ich dich richtig verstehe willst du also bestimmte Zahlen nicht in bestimmten Zeilen sehen. Für den hier verwendeten Zahlenbereich von 0-49 sollte die folgende Codeanpassung funktionieren. Für größere Zahlenbereiche müsstest du mir die genauen Regeln mitteilen (z.B. immer in 10er Blöcken?, wie groß ist der Zielbereich usw.)

Sub ZahlenVerteilen()

Werte = Range("A1:A14")
'oder
Werte = Array(2, 6, 8, 12, 16, 20, 26, 28, 30, 32, 34, 40, 42, 44)
'eine der beiden Zeilen reicht


Set Zielbereich = Range("C1:E25")

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

Randomize Timer
For w = 0 To UBound(Werte)
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/10-19/20-29/30-39/40-49 in Zeile 1,2,3,4,5
If Int(w / 10) = z - 1 Then setzen = False
Case 6 To 9 'nicht 0-9 und 10-19/20-29/30-39/40-49 in Zeile 6,7,8,9
If Int(w / 10) = 0 Or Int(w / 10) = z - 5 Then setzen = False
Case 10 To 12 'nicht 10-19 und 20-29/30-39/40-49 in Zeile 10,11,12
If Int(w / 10) = 1 Or Int(w / 10) = z - 8 Then setzen = False
Case 13 To 14 'nicht 20-29 und 30-39/40-49 in Zeile 13,14
If Int(w / 10) = 2 Or Int(w / 10) = z - 10 Then setzen = False
Case 15 'nicht 30-39 und 40-49 in Zeile 15
If Int(w / 10) = 3 Or Int(w / 10) = z - 11 Then setzen = False
Case 16 To 18 'nicht 0-9 und 10-19 und 20-29/30-39/40-49 in Zeile 16,17,18
If Int(w / 10) = 0 Or Int(w / 10) = 1 Or Int(w / 10) = z - 14 Then setzen = False
Case 19 To 20 'nicht 0-9 und 20-29 und 30-39/40-49 in Zeile 19,20
If Int(w / 10) = 0 Or Int(w / 10) = 2 Or Int(w / 10) = z - 16 Then setzen = False
Case 21 'nicht 0-9 und 30-39 und 40-49 in Zeile 21
If Int(w / 10) = 0 Or Int(w / 10) = 3 Or Int(w / 10) = z - 17 Then setzen = False
Case 22 To 23 'nicht 10-19 und 20-29 und 30-39/40-49 in Zeile 22,23
If Int(w / 10) = 1 Or Int(w / 10) = 2 Or Int(w / 10) = z - 19 Then setzen = False
Case 24 'nicht 10-19 und 30-39 und 40-49 in Zeile 24
If Int(w / 10) = 1 Or Int(w / 10) = 3 Or Int(w / 10) = z - 20 Then setzen = False
Case 25 'nicht 20-29 und 30-39 und 40-49 in Zeile 25
If Int(w / 10) = 2 Or Int(w / 10) = 3 Or Int(w / 10) = z - 21 Then setzen = False
Case 26 To 27 'nicht 0-9 und 10-19 und 20-29 und 30-39/40-49 in Zeile 26,27
If Int(w / 10) = 0 Or Int(w / 10) = 1 Or Int(w / 10) = 2 Or Int(w / 10) = z - 23 Then setzen = False
Case 28 'nicht 0-9 und 10-19 und 30-39 und 40-49 in Zeile 28
If Int(w / 10) = 0 Or Int(w / 10) = 1 Or Int(w / 10) = 3 Or Int(w / 10) = z - 24 Then setzen = False
Case 29 'nicht 0-9 und 20-29 und 30-39 und 40-49 in Zeile 29
If Int(w / 10) = 0 Or Int(w / 10) = 2 Or Int(w / 10) = 3 Or Int(w / 10) = z - 25 Then setzen = False
Case 30 'nicht 1-19 und 20-29 und 30-39 und 40-49 in Zeile 30
If Int(w / 10) = 1 Or Int(w / 10) = 2 Or Int(w / 10) = 3 Or Int(w / 10) = z - 26 Then setzen = False
End Select

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

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

End Sub

Gruß Mr. K.

Answer 6

Uups, ein kleiner Bug ist noch drin. Drück im Codefenster mal Strg+H und ersetze w / 10 durch Werte(w) / 10

Answer 7

hab das jetzt versucht irgendetwas klappt dabei noch nicht so ganz wie ich mir das vorstelle
die zahlen passen diese müssten sich jedoch dann alle 5 zeilen wiederholen dürfen damitt auch die kompletten 18 zeilen ausgefüllt werden können denke mit dem excel screenshot lässt sich das am einfachsten erklären wie genau ich mir das vorstelle




danke schonmal bist ne riesen hilfe :D

lg

Answer 8

ahh fehler von mir auch gleich logischerweise sind es dann keine 14 zahlen die ersten paar reihen sondern weniger also würde sich das früher wiederholen können

Answer 9

http://www.bilder-upload.eu/show.php?file=89a7d4-1495825057.png

Answer 10

Hallo ex13,

das Bild widerspricht deinen bisherigen Angaben. Was soll sich wie widerholen? In der Ausgangsfrage war
die Bedingung, dass keine Zahl doppelt vorkommen darf. Mein Makro ist so aufgebaut, dass mit jeder
Ausführung 14 freie Felder gefüllt werden. Wenn du es also ein zweites Mal ausführst, kommt jede Zahl 2x
vor usw. bis alle Felder gefüllt sind.

Die Reihensortierung im Bild ist anders als von dir beschrieben. Die Reihen, die (nur) keine 0er, 10er, 20er
usw. haben dürfen, stehen nicht wie beschrieben direkt hintereinander. Dadurch kann der Code natürlich
viel einfacher aufgebaut werden. Hab diesen jetzt mal deinem Bild angepasst. Versuch's mal damit:

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 w = 0 To UBound(Werte)
startzeit = Timer

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 Timer >= startzeit + 5 Then Timeout = True
'wenn keine der verfügbaren freien Zellen für die Zahl in Frage kommt.

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

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

End Sub

Du kannst die Bedingungen auch leicht selbst anpassen. Die Logik im Code sagt: wenn in
die x-te Zeile im Zielbereich ausgewählt wurde, prüfe ob das 10tel des aktuellen Wertes dort
reingeschrieben werden darf. Wenn nicht wird die Variable setzen auf False gesetzt.

Gruß Mr. K.