DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub sayi_uret()
sayi = 30 ' üretilen sayı
son = 10 ' san stır
ReDim veri(sayi)
ReDim sayilar(sayi)
Dim Satir As Integer
Columns("A:C").ClearContents
sut = 1
sat = 0
For j = 1 To sayi
atla:
Randomize
Satir = Int((Rnd * sayi) + 1)
For m = 1 To sayi
If Satir = sayilar(m) Then
GoTo atla
End If
Next
[COLOR="Red"]sayilar(j) = Satir[/COLOR]
sat = sat + 1
Cells(sat, sut) = Satir
If sat = son Then
sut = sut + 1
sat = 0
End If
Next
End Sub
cok tsk ler işin rast gelsinde
yalnız aynı sayıdan birden fazla üretmektedir her bir sayıdan bir daha olmaması gerekiyor
'sayilar(j) = Satir
sayilar(j) = Satir
Sub sayi_uret2()
sayi = 30 ' üretilen sayı
son = 10 ' san stır
ReDim veri(sayi)
ReDim sayilar(sayi)
Dim Satir As Integer
Range("A1:C" & son).ClearContents
sut = 1
sat = 0
For j = 1 To sayi
atla:
Randomize
Satir = Int((Rnd * sayi) + 1)
For m = 1 To sayi
If Satir = sayilar(m) Then
GoTo atla
End If
Next
sayilar(j) = Satir
sat = sat + 1
Cells(sat, sut) = Satir
If sat = son Then
sut = sut + 1
sat = 0
End If
Next
Range("A1:A" & son).Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Range("B1:B" & son).Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Range("C1:C" & son).Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
End Sub