Belirli Bir Alanda Rastgele Sayı Üretme

[zafer007]

Bu kodu istediğim hücre aralığından nasıl başlatabilirim. örneğin; A5:A55 gibi..

Sub rastegele_sayı()
Dim X As Byte, SAYI As Byte

Columns(1).ClearContents
For X = 1 To 50
Basla: SAYI = Int((50 * Rnd) + 1)
If WorksheetFunction.CountIf(Columns(1), SAYI) > 0 Or SAYI = 0 Then GoTo Basla
Cells(X, 1) = SAYI
Next
End Sub

 

[zafer007]

Arkadaşlar konu ile ilgili fikri olan var mı ?

 

[leumruk]

Arkadaşlar konu ile ilgili fikri olan var mı ?

Merhaba,
Aşağıdaki kodu deneyin:

Sub rastegele_sayı()
Dim X As Byte, SAYI As Byte
Range("a6:a55").ClearContents
Randomize
For X = 5 To 55
Basla: SAYI = Int((50 * Rnd) + 1)
If WorksheetFunction.CountIf([COLOR="DarkRed"]Range("a6:a55"), [/COLOR]SAYI) > 0 Then GoTo Basla
Cells(X, 1) = SAYI
Next
End Sub

 

[zafer007]

Sn; leumruk

Çok teşekkürler ama burda formülde bir mantık hatası var gibi, benim yapmak istediğim 1-50 kadar olan sayıları örneğin; A2:A51 arasında karıştırması. ve her sayıdan 1 tane olması.

 

[leumruk]

Sn; leumruk

Çok teşekkürler ama burda formülde bir mantık hatası var gibi, benim yapmak istediğim 1-50 kadar olan sayıları örneğin; A2:A51 arasında karıştırması. ve her sayıdan 1 tane olması.

Merhaba,
Kodu güncelledim.

 

[zafer007]

Sn; leumruk

Çok teşekkürler ilginize, ben aşağıdaki şekilde düzenledim ayrıca..

Sub rastegele_sayı()
Dim X As Byte, SAYI As Byte
Set Aralik = Range("A2:A51")
Aralik.ClearContents
Randomize
For X = 2 To 51
Basla: SAYI = Int((50 * Rnd) + 1)
If WorksheetFunction.CountIf(Aralik, SAYI) > 0 Then GoTo Basla
Cells(X, 1) = SAYI
Next
End Sub

 

[karahan61]

Merhabalar
bu kod a2:a51 aralığında benim manuel yazdığım sayıları rastgele düzenlemesi gerekirse nasıl değişiklik yapılmalı

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kod "A2:A..." hücre aralığındaki verileri karıştırarak yeniden A sütununa dizer.

Uygulamalı örnek dosya ektedir.

Option Explicit
 
Sub RASTGELE_KARIŞTIR()
    Dim SON_SATIR As Long, X As Long, SAYI As Long, VERİ As Double, BUL As Variant
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Range("B2:B" & Rows.Count).ClearContents
    
    SON_SATIR = Cells(Rows.Count, 1).End(3).Row
    
    ReDim SIRA_DİZİ(0 To 0)
    ReDim VERİ_DİZİ(0 To 0)
    
    For X = 2 To SON_SATIR
BAŞLA:
        Randomize
        SAYI = Int((Rnd() * SON_SATIR) + 1)
        If SAYI = 1 Then GoTo BAŞLA
            
        VERİ = Cells(SAYI, 1)
        
        BUL = Application.Match(SAYI, Application.Transpose(SIRA_DİZİ), 0)
        If Not IsError(BUL) Then GoTo BAŞLA
        
        ReDim Preserve SIRA_DİZİ(0 To X - 2)
        ReDim Preserve VERİ_DİZİ(0 To X - 2)
        SIRA_DİZİ(X - 2) = SAYI
        VERİ_DİZİ(X - 2) = VERİ
    Next
 
    If SON_SATIR > 0 Then
        Range("A2").Resize(SON_SATIR - 1, 1) = Application.Transpose(VERİ_DİZİ)
    End If
 
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Sub SIRALA()
    Range("A2:A" & Rows.Count).Sort Range("A2")
End Sub