Microsoft Excel

Herbers Excel/VBA-Archiv

VBA Zufallauwahl eingrenzen


Betrifft: VBA Zufallauwahl eingrenzen von: Pusterhofer
Geschrieben am: 31.01.2018 18:41:29

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

  

Betrifft: AW: n-te Auswahl von: Fennek
Geschrieben am: 31.01.2018 18:50:18

Hallo,

als Alternative gibt es den Ansatz der n-ten Auswahl:

- in einer Hilfsspalte eine Zufallszahl generieren
- die 40 (10*4) kleinsten auswählen

So kann es keine Doppelten geben.

mfg


  

Betrifft: AW: n-te Auswahl von: Pusterhofer
Geschrieben am: 31.01.2018 19:15:04

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


  

Betrifft: AW: n-te Auswahl von: Pusterhofer
Geschrieben am: 31.01.2018 20:17:11

Letzter Stand. Der Code läuft nur es ist ihm egal, ob eine Reihe pro 4er Pack doppelt vorkommt.

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



  

Betrifft: AW: n-te Auswahl (Nachtrag) von: Fennek
Geschrieben am: 31.01.2018 20:44:24

Hallo,

am Einfachsten wäre es per Hand:

- 1. Hilfsspalte: =zufallszahl()
- 2. Hilfspalte: Rang

Es geht auch mit VBA von snb (für Spalte A)

Sub M_snb()
    [A1:A100].name = "snb"
    [snb] = "=Rand()"
    [snb] = [index(rank(snb,snb),)]
End Sub
Das Entscheiden ist, auf einmal eine zufällige Reihe ohne Wiederholungen zu erzeugen.

mfg


  

Betrifft: AW: VBA Zufallauwahl eingrenzen von: onur
Geschrieben am: 31.01.2018 21:20:59

Guckst du hier:
https://www.herber.de/bbs/user/119449.xlsm


  

Betrifft: AW: VBA Zufallauwahl eingrenzen von: Pusterhofer
Geschrieben am: 01.02.2018 11:46:07

Vielen Dank! Bin begeistert wie einfach das geht, wenn man weiß wie :D!


  

Betrifft: AW: VBA Zufallauwahl eingrenzen von: onur
Geschrieben am: 01.02.2018 13:39:06

Falls die Koordinaten so eng beieinander liegen, dass es passieren könnte, dass auf Anhieb keine 4 gefunden werden, könnte man in der while-schleife einen zähler einbauen und bei z.B. 100 erfolglosen versuchen entweder eine meldung bringen oder den code wieder zum anfang schicken und eine andere erste zeile finden lassen, denn von der ersten hängt ja alles ab.