Karıştır (Mix) işlemi yapmak!

[adslboy]

Merhaba Arkadaslar,

istediğimi dosya ya yazdım.


ilgilenen arkadaşlara Teşekür Ederim.

 

[Orion1]

Dosyanız ekte.

Sub karistir()
Dim col As Collection, hcr As Range, i As Integer, k As Byte, deg As Variant
Set col = New Collection
For Each hcr In Range("A1:J500")
    col.Add hcr.Value
Next
Application.ScreenUpdating = False
For i = 1 To 500
    Randomize Timer
    For k = 1 To 10
tekrar:
        deg = col(CInt(Int(Rnd() * col.Count - 1) + 1))
        If WorksheetFunction.CountIf(Range("A" & i & ":J" & i), deg) > 0 Then
            GoTo tekrar
            Else
            Cells(i, k).Value = deg
        End If
    Next k
    Range("A" & i & ":J" & i).Sort Range("A" & i), Orientation:=xlLeftToRight
Next i
Application.ScreenUpdating = True
MsgBox "Sayılar rastgele sıralanarak yerleştirildi.", vbOKOnly + vbInformation, "RASTGELE SAYI"
End Sub

 

[adslboy]

Teşekür ederim tam istediğim gibi olmuş .

 

[Orion1]

Teşekür ederim tam istediğim gibi olmuş .

Rica ederim.
Güle güle kullanın.