AW: Zahlen zufällig anordnen
08.08.2005 06:57:53
Erich G.
Hallo Alex und Matthias,
wenn es viele Zahlen sein sollen, geht das schnell mit
Sub Zufallsliste2()
Const Bereich = "C10:C20000"
'Schnelle Erzeugung einer zufälligen Anordnung der Zahlen ab 1
'in einem (fast) beliebig großen Zeilenbereich einer Spalte
'Die aktuelle Auswahl (ActiveCell, Selection) wird wieder hergestellt.
'Voraussetzung: Die letzten zwei Zeilen und drei Spalten der Tabelle sind frei.
Dim bb As Range, merkA As Range, merkS As Range
' aktuelle Auswahlen merken
Set merkA = ActiveCell
Set merkS = Selection
' Leerzellen um Bereich erzeugen (wg. Sort)
Set bb = Range(Bereich)
bb.Columns(1).Insert
bb.Columns(1).Offset(0, 1).Insert
Rows(bb.Cells(1, 1).Row + bb.Cells.Rows.Count).Insert
Rows(bb.Cells(1, 1).Row).Insert
' Zahlen und Zufallszahlen eintragen
bb.FormulaLocal = "=ZEILE()+1-" & bb.Row
bb.Copy
bb.PasteSpecial xlPasteValues, xlNone, False, False
bb.Columns(1).Insert
Randomize
Selection.FormulaLocal = "=ZUFALLSZAHL()"
Selection.Copy
Selection.PasteSpecial xlPasteValues, xlNone, False, False
' Sort nach Zufallszahlen
Selection.Cells(1, 1).Sort Key1:=Selection.Cells(1, 1), Order1:=xlAscending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
' Spalte mit Zufallszahlen löschen
bb.Offset(0, -1).Delete xlToLeft
' Leerzellen um Bereich wieder löschen
bb.Offset(0, -1).Delete xlToLeft
bb.Offset(0, 1).Delete xlToLeft
Rows(bb.Cells(1, 1).Row - 1).Delete
Rows(bb.Cells(1, 1).Row + bb.Cells.Rows.Count).Delete
' Auswahlen wiederherstellen
merkS.Select
merkA.Activate
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort