Startseite

"Sortieren" nach Zufallszahl

Mit diesem Makro können Daten in einer Spalte in eine unsortierte Reihenfolge gebracht werden.
Sortiert
  A
1 Name
2 Alejandra Camino
3 Alexander Feuer
4 Ana Trujillo
5 Anabela Domingues
6 André Fonseca
7 Ann Devon
8 Annette Roulet
9 Antonio Moreno
10 Aria Cruz
11 Art Braunschweiger
12 Bernardo Batista
13 Carine Schmitt
14 Carlos González
15 Carlos Hernández
16 Catherine Dewey
17 Christina Berglund
18 Daniel Tonini
19 Diego Roel
20 Dominique Perrier
 
"Unsortiert"
  A
1 Name
2 Miguel Angel Paolino
3 Laurence Lebihan
4 Lúcia Carvalho
5 Frédérique Citeaux
6 Giovanni Rovelli
7 Paula Parente
8 Alexander Feuer
9 Patricio Simpson
10 Philip Cramer
11 Michael Holz
12 André Fonseca
13 Jaime Yorres
14 Roland Mendel
15 Paula Wilson
16 Helvetius Nagy
17 Yoshi Tannamuri
18 Rita Müller
19 Annette Roulet
20 Yang Wang
 
Diagramm - Grafik - Excel Tabellen einfach im Web darstellen    Excel Jeanie HTML  3.0    Download  
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