Sayı Üretme

[Levo 1956]

Selamlar..

Örnekte göndermiş olduğum sayı üretme kodunda küçük bir sorunum var.
Random olarak üretilen 6 sayı var.Aynı sayıların tekrar edilmemesi için ne yapabilirim bu konuda yardımcı olursanız sevinirim.
Örnek olarak;Üretilen sayılar 1,3,2,3,3,4 gibi
benim istediğim 5.1.3.6.4.2 şeklinde olması
Yardımlarınız için şimdiden teşekkürler.

 

[Mahir64]

Merhaba,

http://www.excel.web.tr/f47/videoda-anlatylan-mrand-fonksiyonu-t113616.html#post618563

Bu konuyu incelemenizde yarar var. Aradığınız çözüm olmayabilir fakat fikir verir.

Eklenti olarak kullanılan MRAND fonksiyonu, MRAND(satır_sayısı;birinci değer;ikinci değer) olarak kullanılır.
MRAND(10;1;10) DİZİ formülüdür.

 

[Korhan Ayhan]

Merhaba,

Alternatif olarak aşağıdaki kodu deneyin.

Sub SAYI_ÜRET()
    Dim Sayı As Byte, Satır As Integer, X As Byte
    
    Satır = Cells(Rows.Count, 1).End(3).Row + 1
    X = 1
    
10  Randomize
    Sayı = Int(Rnd() * 6) + 1
    If WorksheetFunction.CountIf(Range("A" & Satır & ":F" & Satır), Sayı) <> 0 Then GoTo 10
    Cells(Satır, X) = Sayı
    X = X + 1
    If X > 6 Then GoTo Son
    GoTo 10
Son:
End Sub

 

[Levo 1956]

İlginize çok teşekkür ederim. Tam istediğim gibi
Sevgiler.

 

[Levo 1956]

Koray bey gerçekten çok işime yaradı sonsuz teşekkürler.
Son bir sorum olacak
Sayılar A2:F2 hücreleri arasında çıkıyor ve devam ediyor bu sayıları istediğim hücre aralığına nasıl taşıyabilirim?
Deneme yanılma ile bazı sayı ve harfleri değiştirdim ama maalesef olmadı.
Sevgiler...

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kod ile istediğiniz hücreden başlatabilirsiniz.

İlk hücreyi seçip makroyu çalıştırın.

Sub SAYI_ÜRET()
    Dim Sayı As Byte, Satır As Integer, X As Byte, Adres As String
    
    If ActiveCell = "" Then
        Satır = ActiveCell.Row
    Else
        Satır = Cells(Rows.Count, ActiveCell.Column).End(3).Row + 1
    End If
    
    X = ActiveCell.Column
10  Randomize
    Sayı = Int(Rnd() * 6) + 1
    Adres = Cells(Satır, ActiveCell.Column).Address & ":" & Cells(Satır, ActiveCell.Column + 5).Address
    If WorksheetFunction.CountIf(Range(Adres), Sayı) <> 0 Then GoTo 10
    Cells(Satır, X) = Sayı
    X = X + 1
    If WorksheetFunction.CountA(Range(Adres)) = 6 Then GoTo Son
    GoTo 10
Son:
End Sub

 

[Levo 1956]

Çok teşekkür ederim
Sevgiler

 

[Levo 1956]

Selamlar..
Koray bey gerçekten çok güzel bir kod çok işime yarıyor.
Ama yine bir sıkıntım var.Hücre seçimini kod içinde yapabilirmiyiz .
Sevgiler

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kodu denermisiniz.

Sub SAYI_ÜRET()
    Dim Sayı As Byte, Satır As Integer, X As Byte, Adres As String, Hücre As Range
 
    On Error Resume Next
    Application.DisplayAlerts = False
 
    Set Hücre = Application.InputBox("İşlemi yapmak istediğiniz hücreyi seçiniz !" & Chr(10) & _
                "Lütfen tek hücre seçiniz !", "Hücre Seçimi", , , , , , 8)
 
    On Error GoTo 0
    Application.DisplayAlerts = True
 
    If Not Hücre Is Nothing Then
        If Hücre.Value = "" Then
            Satır = Hücre.Row
        Else
            Satır = Cells(Rows.Count, Hücre.Column).End(3).Row + 1
        End If
 
        X = Hücre.Column
10      Randomize
        Sayı = Int(Rnd() * 6) + 1
        Adres = Cells(Satır, Hücre.Column).Address & ":" & Cells(Satır, Hücre.Column + 5).Address
        If WorksheetFunction.CountIf(Range(Adres), Sayı) <> 0 Then GoTo 10
        Cells(Satır, X) = Sayı
        X = X + 1
        If WorksheetFunction.CountA(Range(Adres)) = 6 Then GoTo Son
        GoTo 10
    Else
        MsgBox "Hücre seçimi yapmadığınız için işleminiz iptal edilmiştir.", vbExclamation
    End If
Son:
End Sub

 

[Levo 1956]

Koray bey alakanıza çok teşekkür ederim.

Kodlar çok güzel ancak benim istediğim;kod içine hangi hücreden başlaması gerektiğini yazarak, sonrasında sürekli devam etmesi şeklinde.Hücreyi kod içinde ben belirleyeyim. Eğer böyle bir kod olursa çok sevinirim.
Sizi yorduğum için lütfen bağışlayın.
Sevgiler.

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki şekilde kullanabilirsiniz.

Sub SAYI_ÜRET()
    Dim Sayı As Byte, Satır As Integer, X As Byte, Adres As String
    
[COLOR=red]    Range("A1").Select
[/COLOR]    
    If ActiveCell = "" Then
        Satır = ActiveCell.Row
    Else
        Satır = Cells(Rows.Count, ActiveCell.Column).End(3).Row + 1
    End If
    
    X = ActiveCell.Column
10  Randomize
    Sayı = Int(Rnd() * 6) + 1
    Adres = Cells(Satır, ActiveCell.Column).Address & ":" & Cells(Satır, ActiveCell.Column + 5).Address
    If WorksheetFunction.CountIf(Range(Adres), Sayı) <> 0 Then GoTo 10
    Cells(Satır, X) = Sayı
    X = X + 1
    If WorksheetFunction.CountA(Range(Adres)) = 6 Then GoTo Son
    GoTo 10
Son:
End Sub

 

[Levo 1956]

Korhan bey size ne kadar teşekkür etsem azdır işte istediğim buydu .
çok sağ olun
Sevgiler