Zufallsgenerator VBA

[TresPuntos]

Hallo,

meine VBA Kenntnisse sind etwas eingerostet, bzw meine Programmierskills.
Ich möchte eine Art Zufallsgenerator erstellen.
Es existiert eine Liste mit Namen in der Spalte A1:A30, B1:B30, C1:C30 und in D gibt es weniger Zellen D115.
Bei Buttondruck soll nämlich eine zufällige Zelle aus jeder Spalte genommen werden und in ein anderes Tabellenblatt kopiert werden.
Dieser Vorgang muss 30 mal wiederholt werden, damit jeder Name auch im anderen Tabellenblatt existiert.
Im Tabellenblatt sollen die zufällig ausgesuchten Namen untereinander unter den Spalten eingefügt werden, sodass beispielsweise unter A 4 Namen stehen ... unter K 4 Namen stehen. In etwa so:

Wie kann ich so etwas erzeugen?

 

[nik_]

also an deiner stelle alles auf englisch googlen und dann zusammenbasteln und testen. so mache ich das auch immer bei vba

 

[Scientist]

kA, ob es sinnvoll ist, jedenfalls kommt mir das spontan in den Sinn:
Eintraege in ein Array laden.
Mit "Int(Rnd * Ubound(Array) + 1)" (oder so) per Zufall einen Eintrag bestimmen.
Zufaellig gewählten Eintrag aus dem Arrays entfernen bzw. das Array neu definieren.
Solang wiederholen, bis nur noch 1 Eintrag vorhanden ist.

 

[TresPuntos]

Ja hat mir gut geholfen @Scientist
Mein Code ist jetzt fertig und sieht wie folgt aus:

Sub Zufall()
    Dim k As Integer
    Dim vntList As Variant, vntTmp As Variant
    Dim lngIndex As Long, lngRnd As Long
    Dim i As Integer, b As Integer
    Range("A1:H30").Select
    Selection.Copy
    For b = 2 To 6
        For i = 1 To 8
            vntList = Range(Cells(1, i), Cells(30, i))
            Randomize Timer
            For lngIndex = 1 To UBound(vntList, 1)
              lngRnd = Int((UBound(vntList, 1)) * Rnd + 1)
              vntTmp = vntList(lngIndex, 1)
              vntList(lngIndex, 1) = vntList(lngRnd, 1)
              vntList(lngRnd, 1) = vntTmp
            Next
            Worksheets(b).Select
            Cells(1, i).Resize(UBound(vntList, 1), 1) = vntList
            Sheets("Tabelle1").Select
        Next i
    Next b
End Sub

 

[Scientist]

Statt mit Select zu arbeiten, wuerde ich die Zellen direkt ansprechen (Tabelle1.Range("A1:H30").copy , usw.).
Mit "Application.ScreenUpdating = False" kann die Bildschirmaktualisierung deaktiviert werden.
Spart etwas Zeit und der Bildschirm flackert nicht so vor sich hin ...
Muss am Ende aber wieder aktiviert werden.

 

[TresPuntos]

Die Funktion als solches steht, aber wie ist es möglich die Zellen ohne ihre Formatierung einzufügen. Es soll die Formatierung nicht mit eingefügt werden, damit ich die einzelnen Tabellen übersichtlicher gestalten kann.

mit Sheets("Datei2).Range("B4").PasteSpecial Paste:=xlPasteValues klappt es in meinem Beispiel nicht
und mir ist bewusst, dass ich das auf mein Beispiel übertragen muss.

Sub Zufall()
    Dim k As Integer
    Dim vntList As Variant, vntTmp As Variant
    Dim lngIndex As Long, lngRnd As Long
    Dim i As Integer, b As Integer
    Range("A2:H31").Select
    Selection.Copy
    For b = 2 To 6
    Worksheets(b).Range("B:I").Clear
        For i = 1 To 8
            vntList = Range(Cells(2, i), Cells(31, i))
            Randomize Timer
            For lngIndex = 1 To UBound(vntList, 1)
              lngRnd = Int((UBound(vntList, 1)) * Rnd + 1)
              vntTmp = vntList(lngIndex, 1)
              vntList(lngIndex, 1) = vntList(lngRnd, 1)
              vntList(lngRnd, 1) = vntTmp
            Next
            Worksheets(b).Cells(1, i + 1).Resize(UBound(vntList, 1), 1) = vntList
            Worksheets(b).Columns(i).AutoFit
            If Worksheets(b).Columns(i).ColumnWidth < 10 Then
                Worksheets(b).Columns(i).ColumnWidth = 10
            End If
        Next i
    Next b
End Sub

 

[Scientist]

Bei mir werden mit deinem Code keine Formatierungen uebernommen.
Beim Einlesen eines Array muessten eigentlich auch nur die Werte uebernommen werden.
Weil es bei mir aber schon etwas her, bin ich mir an der Stelle etwas unsicher.
Ansonsten muesste in Zeile 19 ein ".value" bei der Zielzelle reichen.

Ansonsten:
Sind ggf. Formatierungen irgendwann zuvor einmal kopiert und seitdem nicht geloescht worden?

Btw.:
Zeile 6 und 7 kannst du loeschen.