tekrarsız rastgele dağıtım

[ekoert]

Merhaba,

Belli bir alanda yer alan verileri, örneğin (A1:C5)'te, rastgele tekrarsız dağıtmak mümkün mü? (Veri metin içeriyor)

Sadece sütunda ve sadece satırda tekrarsız dağıtım yapılan örnekler gördüm. Seçilen alanda rastgele dağıtım yapılmasını istiyorum.

Makro veya fonksiyonlu çözüm fark etmez.

NOT: Esasında amacım bir bütünü kuralsız olarak dağıtmak. Nasıl dağıtıldığının hiçbir önemi yok, yeter ki dağıtım belli bir kural içermesin.

Saygılarımla.

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Rastgele_Dagit()
    Dim Veri As Variant, X As Long, Kontrol As Object, Say As Long
    Dim Satir As Long, Sutun As Integer, Y As Integer, Adres As String
    
    Set Kontrol = CreateObject("Scripting.Dictionary")
    
    Veri = Range("A1:C5").Value
    
    ReDim Liste(1 To UBound(Veri, 1), 1 To UBound(Veri, 2))
    
    Randomize Timer
    
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        For Y = LBound(Veri, 2) To UBound(Veri, 2)
10          Satir = Evaluate("=RANDBETWEEN(1," & UBound(Veri, 1) & ")")
            Sutun = Evaluate("=RANDBETWEEN(1," & UBound(Veri, 2) & ")")
            Adres = Cells(Satir, Sutun).Address
            If Not Kontrol.Exists(Adres) Then
                Say = Say + 1
                Kontrol.Add Adres, Say
                Liste(X, Y) = Veri(Satir, Sutun)
            Else
                GoTo 10
            End If
        Next
    Next
    
    Range("A1").Resize(UBound(Veri, 1), UBound(Veri, 2)) = Liste

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[ekoert]

Korhan Bey çok teşekkürler.

Emeğinize sağlık.