zufällige Zeilenanordnung

Hallo ihr lieben VBA Experten,

könnte mir bitte Jemand helfen bei einer Anordnung nach dem Zufallsprinzip.

Und zwar sollen in vier aneinanderhängende Spalten ( Bsp. A,B,C,D ), und der
Zellen, bzw. Zeilenbereich von Zeile12 Zeile 507 ( also A12 D507 )vertauscht werden,
und zwar nach zufälliger Anordnung.
Zwei Kriterien wären zu beachten:
- es soll nur Zeilenweise vertauscht werden, d.h. wenn der hinter einander stehende Wert
aus Bsp. Zeile 23 ( A,B,C,D ) vertauscht wurde mit Bsp. Zeile 122, dann stehen die
vorherigen Werte aus Zeile 23 jetzt in Zeile122 ( nach Zufallsprinzip ), und zwar
( A,B,C,D) und nicht Bsp. ( B,A,D,C usw. ).
- Leere Zeilen ( also wenn die Liste sozusagen nur bis Bsp. Zeile 233 ausgefüllt wurde )
sollen dann ab ( hier im Bsp. ) Zeile 233 nicht mehr berücksichtigt werden , um in der
Gesamtauflistung keine leere Zeilen dazwischenzufügen.

Wäre euch sehr zu Dank verbunden, leider kenn ich mich noch viel zu wenig in VBA aus, um mich solch einem Problem zu stellen. Sollte aber schon ein VBA sein, da ich es als Makro mit einem spez. Steuerbutton verknüpfen möchte.

Also vielen herzlichen Dank im Voraus, hoffe auf eure Hilfe .

udo-de@web.de

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Udo,

hier ist Dein Makro:

Sub zufall()
Dim oBl1 As Worksheet
Dim oBl2 As Worksheet
Dim iStartSp As Integer, iEndSp As Integer
Dim iStartZl As Integer, iEndZl As Integer
Dim iZufallZl As Integer
Dim iZähler As Integer

Application.DisplayAlerts = False
Application.ScreenUpdating = False

'Definitionen
Set oBl1 = Worksheets("Tabelle1")
iStartSp = 1: iEndSp = 4 'nummer der Start- und Endspalte des Bereichs
iStartZl = 12: iEndZl = 507 'Nummer der Start- und Endzeile des Bereichs

'neues Blatt als temporäre Quelle
Set oBl2 = Worksheets.Add
oBl1.Activate
'Bereich in neues Blatt an gleiche Stelle verschieben
oBl1.Range(Cells(iStartZl, iStartSp), Cells(iEndZl, iEndSp)).Cut _
Destination:=oBl2.Cells(iStartZl, iStartSp)
oBl2.Activate
'Zähler für zielzeile setzen
iZähler = iStartZl
For i = iEndZl To iStartZl Step -1
'zufällige Zeilenauswahl
iZufallZl = Int((i - iStartZl + 1) * Rnd + iStartZl)
If Not (oBl2.Cells(iZufallZl, iStartSp).Value = Empty) Then
'nur nichtleere Zeilen kopieren
oBl2.Range(Cells(iZufallZl, iStartSp), Cells(iZufallZl, iEndSp)).Copy _
Destination:=oBl1.Cells(iZähler, iStartSp)
iZähler = iZähler + 1
'bereits kopierte Zeilen löschen
oBl2.Rows(iZufallZl).Delete
End If
Next
'Hilfsblatt löschen
oBl2.Delete

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Ggf. musst Du noch bei Set oBl1=... den Namen Deiner Tabelle anpassen. Falls Du andere Bereiche zufällig ordnen willst musst Du nur die Zeilen- und Spaltennummer im Bereich Definitionen ändern.

Viel Spaß beim Mischen.
Steffan

Beliebteste Forumthreads (12 Monate)

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread