çekiliş kod sorunu

[ustasoft]

Merhabalar ;
çekiliş programı kodları aşağıda.
sorunum a stununda personel listesi var yaklaşık 1200 kişi.

vb kodta çekilişi başlat dediğimde 1200 kişi içersinde genellikle hep aynı isimler çıkıyor.
sorun sizce nedir acaba ?

tşk

Sub tombala()
If [b65536].End(3).Row - 1 = [a65536].End(3).Row Then
MsgBox "Çekilik Tamamlanmýþtýr."
Exit Sub
End If
For a = 1 To 25
For b = 1 To 6000
DoEvents
Next
deg = Int(Rnd * [a65536].End(3).Row) + 1
[c2] = Cells(deg, "a")
Next
10 deg = Int(Rnd * [a65536].End(3).Row) + 1
If WorksheetFunction.CountIf([b:b], Cells(deg, "a")) = 0 Then
[b65536].End(3).Offset(1, 0) = Cells(deg, "a")
[c2] = Cells(deg, "a")
[b2:b65536].Sort Key1:=[b2], Order1:=xlAscending
Else
GoTo 10
End If
End Sub
Sub sifirla()
[c2:c3,b2:b65536].ClearContents
End Sub
te

 

[ÖmerFaruk]

Aşağıdaki satırın önüne randomize ifadesi koyunca düzeliyor mu bakar mısın
Randomize
10 deg = Int(Rnd * [a65536].End(3).Row) + 1

Excel şöyle der;
"Warning: If you don't call the Randomize function before calling the Rnd function, the Rnd function may return the same random number value each time. And therefore, you may not get a truly random number."

 

[ustasoft]

düzeldi teşekkürler
birde b stununa isimleri alfabetik sıraya göre sıralıyor. bunu çekiliş sırasına göre nasıl b stununa yazdırabilirim ?

 

[ÖmerFaruk]

[b2:b65536].Sort Key1:=[b2], Order1:=xlAscending
Yerine aşağıdaki denermisin
[b2:c65536].Sort Key1:=[c2], Order1:=xlAscending

 

[ustasoft]

[b2:b65536].Sort Key1:=[b2], Order1:=xlAscending

bu kodu tamamen sildim düzeldi. teşekkürler desteğin için