Option Explicit
Sub spalteninhalte_mischen()
' Variablen deklarieren
Dim z As Integer, zz As Integer
Dim arr(800, 0) As Variant
Dim s As Integer
Dim w As Integer
Dim az As Integer
Application.ScreenUpdating = False ' Bildschirmaktualisieren abschalten
z = Range("A65536").End(xlUp).Row ' Letzte gefüllte Zelle ermitteln
For s = 2 To z ' Schleifenstart
zz = Range("A65536").End(xlUp).Row ' Höchstwert für Zufallszahl
w = Int((zz - 2 + 1) * Rnd + 2) ' Zuffalszahl festlegen
If Cells(w, 1) <> "" Then ' wenn ausgewählte Zelle nicht leer, dann ...
arr(az, 0) = Cells(w, 1) ' ... Zellinhalt in Array eintragen
az = az + 1 ' ... Zähler für Array plus 1
Cells(w, 1).Delete Shift:=xlUp ' ... Inhelt der gelesenen Zelle löschen
End If ' Ende der Bedingungen
Next s ' Schleife plus 1
Range("A2", "A" & z) = arr ' Array in Tabelle eintragen
Application.ScreenUpdating = True ' Bildschirmaktualisierung einschalten
End Sub
Code eingefügt mit: Excel Code Jeanie |