ich habe eine Tabelle mit 5444 Zeilen und möchte 444 Zeilen nach dem Zufallsprinzip löschen.
Gibt es da eine Möglichkeit?
Viele Dank!
Jan-Gerrit
Sub loeschen()
Dim I As Integer
Do Until I = 444
Cells(Rnd() * (5445 - I), 1).EntireRow.Delete
I = I + 1
Loop
End Sub
Bin aber nicht sicher, ob das 100% sauber ist?!
Gruß
Uwe
(:o)
Sub ZufallsZeilenLöschen()
Dim i As Long
Dim ze As Long
For i = 5444 To 5001 Step -1
ze = CLng(Rnd(i) * i) + 1
Rows(ze).Delete
Next
End Sub
Gruß, Daniel
Sub ZufallsZahlen()
Dim dblZahlen() As Long, dblGezogen() As Variant
Dim intCount As Integer, intIndex As Integer, intZufall As Integer
Dim intStart As Integer, intEnde As Integer, intAnzahl As Integer
intStart = 1 'Erste Zahl
intEnde = 5444 'Letzte Zahl
intAnzahl = 444 'Anzahl Zufallszahlen
ReDim dblZahlen(intEnde - intStart)
ReDim dblGezogen(intAnzahl - 1)
'Array füllen
For intCount = intStart To intEnde
dblZahlen(intIndex) = intCount
intIndex = intIndex + 1
Next
intIndex = 0
Randomize Timer
'Zufallszahlen ziehen
For intCount = 0 To intAnzahl - 1
intZufall = Int(Rnd() * UBound(dblZahlen))
dblGezogen(intIndex) = dblZahlen(intZufall)
dblZahlen(intZufall) = dblZahlen(UBound(dblZahlen))
If UBound(dblZahlen) = 0 Then Exit For
ReDim Preserve dblZahlen(UBound(dblZahlen) - 1)
intIndex = intIndex + 1
Next
'Zufallszahlen sortieren
QuickSort dblGezogen
'In Bereich ausgeben (ab "A1")
'Range(Cells(1, 2), Cells(intAnzahl, 2)) = Application.Transpose(dblGezogen)
'die Zufallszeilen löschen
For intIndex = 443 To 0 Step -1
Rows(dblGezogen(intIndex)).Delete Shift:=xlUp
Next intIndex
End Sub
' Quicksort
'
Sub QuickSort(data() As Variant, Optional UG, Optional OG)
Dim P1&, P2&, T1 As Variant, T2 As Variant
UG = IIf(IsMissing(UG), LBound(data), UG)
OG = IIf(IsMissing(OG), UBound(data), OG)
P1 = UG
P2 = OG
T1 = data((P1 + P2) / 2)
Do
Do While (data(P1) T1)
P2 = P2 - 1
Loop
If P1 P2)
If UG
Gruß Peter
= Zufallszahl()
- Formel in Spalte B:
=WENN(RANG(A1;A:A)
- jetzt kannst du die zufällig gewählten Zeilen löschen:
entweder über den Autofilter nach WAHR
oder über: Spalte B markieren, BEARBEITEN - GEHE ZU - INHALTE - FORMELN - WAHRHEITSWERTE klicken, und dann BEARBEITEN - ZELLEN LÖSCHEN - GANZE ZEILE
Gruß, Daniel
=WENN(RANG(A1;A:A)
geht auch kürzer!
=RANG(A1;A:A)
ergibt WAHR oder FALSCH
Grüße,
Klaus M.vdT.