Satırı Rastgele sıralama (Random satır)

[Kavinsky]

Merhabalar,yaptığım araştırmalar neticesinde tam problemimi çözecek net bir sonuca ulaşamadım. Rastgele hücre sıralayan var ama satır sıralayan yok.

Benim istediğim şudur dolu olan satırları rastgele sıralasın ama satırdaki bilgiler birden fazla hücre olduğu için hücre bazında sıralamasın. Bu sefer bilgiler karışır yani örnek olarak 1.satırı alıp rastgele 42. satıra yapıştırsın ama tüm verileri alarak yapıştırsın ki bilgiler karışmasın.
Böyle bir şey mümkün müdür ?

 

[PLİNT]

Merhaba
Ekdeki örneği denermisiniz?
http://www.dosya.tc/server10/uat4v9/Kitap1.zip.html

[SIZE="2"]Private Sub CommandButton1_Click()
Dim data As Variant
Dim lis(): Dim syf()
Dim x As Long
Dim i As Long
Set s1 = Sheets("Sayfa1")
x = s1.Cells(Rows.Count, "A").End(3).Row
data = UniqueRandomNumbers(x, 1, x)
syf = s1.Range("A1:G" & x).Value
ReDim lis(1 To 7, 1 To x)
For i = 1 To x
For m = 1 To 7
lis(m, data(i)) = syf(i, m)
Next
Next
s1.Range("A1:G" & Rows.Count) = Empty
s1.Cells(1, 1).Resize(x, 7) = Application.Transpose(lis)
End Sub
[/SIZE]

[SIZE="2"]Function UniqueRandomNumbers(NumCount As Long, LLimit As Long, ULimit As Long) As Variant
Dim RandColl As Collection, i As Long, varTemp() As Long
UniqueRandomNumbers = False

If NumCount < 1 Then Exit Function
If LLimit > ULimit Then Exit Function
If NumCount > (ULimit - LLimit + 1) Then Exit Function
Set RandColl = New Collection
Randomize
Do
On Error Resume Next
i = CLng(Rnd * (ULimit - LLimit) + LLimit)
RandColl.Add i, CStr(i)
On Error GoTo 0
Loop Until RandColl.Count = NumCount

ReDim varTemp(1 To NumCount)

For i = 1 To NumCount
varTemp(i) = RandColl(i)
Next i

Set RandColl = Nothing
UniqueRandomNumbers = varTemp
Erase varTemp
End Function
[/SIZE]

 

[Kavinsky]

Üstadım ellerine sağlık, tam istediğim gibi. Emeklerin için teşekkür edeirm.