VBA Zufallauwahl eingrenzen

Hallo,
Ich bin mal wieder an meine VBA Grenzen gestoßen und auf der Suche nach Hilfe. Im Moment versuche ich ein Makro zu schreiben, das mir aus meiner Datei mit 378 Reihen zufällig 10x 4 Reihen ausgibt. Das funktioniert auch soweit.
Das Programm kopiert mir eine Zufällige Reihe von A bis F:
Range("A" & i & ": F" & i).Copy
In der Spalte A, B, C sind die X, Y, Z Koordinaten eines Punktes hinterlegt in den Reihen D-F dazugehörige Werte.
Jetzt mein Problem: gibt es eine Möglichkeit, dass pro 4 Reihen keine 2 mal vorkommt und dass _ die 4 zufällig gewählten Reihen/Punkte in jeder Richtung mindesten 1m Abstand zu sich haben. Würde mich über jeden Input freuen.


Sub Zufall4erPack()
Dim ZZahl, a As Long, b As Long, j As Long, k As Long
j = 378                                             'Anzahl der Zellen'
k = 380                                             'Kopieren Ausgabe
Set wsAktuell = ThisWorkbook.Worksheets("Tabelle1")
For a = 1 To 10
For b = 1 To 4
Randomize
ZZahl1 = Int((j * Rnd) + 1)        'Zufallszahl wird ermittelt
zzahl2 = ZZahl1 + 2                'Zur Zufallszahl wird 2 addiert, da es ab 2 Reihe  _
funktionieren soll
i = zzahl2
Range("H" & k).Value = i                            'Gibt gewählte Zelle aus als Kontrolle'
Range("A" & i & ": F" & i).Copy
Range("A" & k).PasteSpecial xlPasteValues
k = k + 1
Next b
k = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row + 2
Next a
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Danke dann wende ich es mal so versuchen. Mein jetziger Ansatz funktionier so nicht:
Sub Zufall()
Dim ZZahl, a As Long, b As Long, c As Long, j As Long, k As Long, l As Long, ergebnis As Boolean
j = 36 'Anzahl der Zellen'
k = 42 'Kopieren Ausgabe
l = 42
For a = 1 To 10
For b = 1 To 4
Randomize
ZZahl1 = Int((j * Rnd) + 1) 'Zufallszahl wird ermittelt
zzahl2 = ZZahl1 + 2 'Zur Zufallszahl wird 2 addiert, da es ab 2 Reihe funktionieren soll
i = zzahl2
Range("H" & k).Value = i 'Gibt gewählte Zelle aus als Kontrolle'
Range("A" & i & ": F" & i).Copy
Range("A" & k).PasteSpecial xlPasteValues
For c = l To l + 3
If Range("H" & c).Value = i Then
b = b - 1
Else
k = k + 1
End If
Next c
Next b
k = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row + 2
l = k
Next a

Sub Zufall() Dim ZZahl, a As Long, b As Long, c As Long, j As Long, k As Long, l As Long, Wert_vorhanden As _ Boolean j = 36 'Anzahl der Reihen' k = 42 'Kopieren Ausgabe l = 42 For a = 1 To 10 For b = 1 To 4 Randomize ZZahl1 = Int((j * Rnd) + 1) 'Zufallszahl wird ermittelt zzahl2 = ZZahl1 + 2 'Zur Zufallszahl wird 2 addiert, da es _ ab 2 Reihe funktionieren soll i = zzahl2 For c = 1 To 4 'Kontrolle ob pro 4 Reihen eine doppelt _ vorkommt If Range("H" & l).Value = i Then Wert_vorhanden = True Else Wert_vorhanden = False End If l = l + 1 Next c If Wert_vorhanden = True Then b = b - 1 Else Range("H" & k).Value = i 'Gibt gewählte Zelle aus als Kontrolle' Range("A" & i & ": F" & i).Copy Range("A" & k).PasteSpecial xlPasteValues k = k + 1 End If Next b k = ActiveSheet.Cells(Rows.Count, 8).End(xlUp).Row + 2 l = k Next a End Sub

Beliebteste Forumthreads (12 Monate)

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread