Karışık sayı üretme ve sıralama

[Harun_Y]

Merhaba arkadaşlar.
Konuyu açmadan önce araştırdım ama benimkinden çok daha karmaşık şeylere rastladım o yüzden anlamadığım için yardımınızı istiyorum.

Bir dosyada 100 kişilik liste var ve 4 sütün
A Hücresinde Sıra Numarası B de Kimlik no C'de Ad D'de Soyad

Benim yapmak istediğim sadece A hücresindeki sıra numaraları değişsin ama aynı numarayı iki kişiye vermesin oluşan sıralamaya göre liste yeniden oluşsun. Yardımınız için teşekkür ederim şimdiden

 

[Emir Hüseyin Çoban]

. . .

Ekran Görüntüsü (GİF):

Sub kod()
    Son = Cells(Rows.Count, "B").End(3).Row
    
    Dim arr() As Long
    Min = "1"
    Max = Son - 1
    ReDim arr(Max - Min)
    say = 0
    For i = Min To Max
        arr(say) = i
        say = say + 1
    Next
    
    For j = 0 To UBound(arr)
        x = Int(((Max - Min) * Rnd))
        temp = arr(x)
        arr(x) = arr(j)
        arr(j) = temp
    Next j
    For i = 0 To UBound(arr)
        Cells(i + 2, "A") = arr(i)
    Next
    
    Range("A2:D" & Son).Sort Range("A2"), xlAscending
    
End Sub

 

[Harun_Y]

Çok Teşekkür ederim