Rastgele sayı üretme kodlarında düzenleme

[kamsal]

Aşağıdaki kodu deneyin.

Sub Calistir()
If [n2] > 11 Then Exit Sub
Sut = Cells(1, [n2]).End(1).Column + 1
If Cells(1, 1) = "" Then Sut = 1
Randomize
For i = 1 To [n1]
BASLA:
Sayi = Int(Rnd * [n1] + 1)
If WorksheetFunction.CountIf(Range(Cells(1, Sut), Cells([n1], Sut)), Sayi) > 0 Then GoTo BASLA
Cells(i, Sut) = Sayi
Next i
If Cells(1, [n2]) <> "" Then
Sor = MsgBox("Tüm sütunlar dolmuştur. İşleme yeniden başlamak istiyor musunuz?", vbQuestion + vbYesNo, "UYARI")
If Sor = vbNo Then Exit Sub
If Sor = vbYes Then
Range("a:k") = ""
Exit Sub
End If
End If
End Sub

Sayın lumruk hocam,
Benim dosyamada bir el atsanız çok memnun olurum. Bir yerlerden kodlar buldum yapıştırdım ama istediğim bir türlü olmadı...! sizin dosyada aşağıya doğru sayı üretiyor.. ben sağa doğru sayı üretmesini istiyorum. Yardımcı olmanızı çok rica ederim.

 

[kamsal]

Acele etmiyorum ve bekliyorum. Biliyorum ki bir üstad bana yardım edecek Saygılarımla

 

[leumruk]

Acele etmiyorum ve bekliyorum. Biliyorum ki bir üstad bana yardım edecek Saygılarımla

Sn. kamsal,
Açıklamanız yeterli değil. Sayıyı neye göre üretecek. Örneğin ilk satırdaki 15 rakamıyla sayı üretmenin ne tür bir ilişkisi var. Ayrıca kaç adet sayı üreteceğini nereden bileceğiz.

 

[kamsal]

Sayın leumruk,

15 sayısını toplam üretim miktarına göre formüllü şekilde buluyor. Bu sayılar 3 ile maksimum 60 arasında değişiyor.

Ben her seferinde sayıya göre sağda bulunan satırlara el ile 2 sayısını geçmeyecek şekilde 1,1,2 vb. şekilde giriş yapıyorum.

Bu girişlerde bizde formalite olarak yapılan kalite kontrol işleminde tespit edilen hatalı miktarılarını gösteriyor.

Özetle şöyle anlatayım; Toplam üretim miktarına göre 3 ile 60 arasında çıkan "kontrol edilecek numune miktarı"na istinaden ben sağda bulunan hata kriterlerine rastgele el ile her seferinde farklı kriterlere 1 ve en yüksek 2 giriyorum.

İstiyorumki soldaki sayı en az 6 ise, sağdaki hata kritlerine her seferinde (her satırda) rastgele 1,1,2 gibi sayılar atasın ve bende sürekli el ile girmekten kurtulayım çünkü bu işlem oldukça zaman alıyor..

Umarım anlatabilmişimdir.. yardımlarınızı rica ediyorum.

 

[leumruk]

Açıklamalarınızdan anladığım kadarıyla aşağıdaki kod işinizi görecektir.

Sub Makro1()
For Each x In Range("b2:h7")
If Cells(x.Row, 1) > 5 Then
sayi = WorksheetFunction.RandBetween(0, 2)
    Cells(x.Row, x.Column) = IIf(sayi = 0, "", sayi)
End If
Next
End Sub

 

[kamsal]

Açıklamalarınızdan anladığım kadarıyla aşağıdaki kod işinizi görecektir.

Sub Makro1()
For Each x In Range("b2:h7")
If Cells(x.Row, 1) > 5 Then
sayi = WorksheetFunction.RandBetween(0, 2)
    Cells(x.Row, x.Column) = IIf(sayi = 0, "", sayi)
End If
Next
End Sub

Sayın leumruk hocam hayırlı cumalar diliyor ve ilginize teşekkür ediyorum. Ancak ben sizden farklı bir konuda yardım isteyecektim. Konu yine aynı ama ben forumdan istediğime benzer bir şeyler buldum, uyguladım ve aşağı yukarı oldu.

Hocam ben dosya içinde açıklamayı yaptım. İstediğim şöyle; bir sayfada kullandığım makroyu tüm çalışma kitabında kullanmak istiyorum. Bu konuda yardım ederseniz sevinirim.

 

[kamsal]

Birde otomatik olarak üretilecek değerler toplamının, alınacak numune toplamının %2-3 civarında olmasını ayarlayabilirseniz tam benim istediğim olacak. Saygılarımla

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kodu denermisiniz.

Not : "İz Açma" isimli sayfanızda "Hat 1" gibi değerler var. Bunları "Hata 1" şeklinde düzelttikten sonra kodu çalıştırın.

Sub Düğme1_Tıklat()
    Dim Sayfa As Worksheet
    Dim Alt_Limit As Double
    Dim Üst_Limit As Double
    Dim Sayı As Double
    Dim Sütun As Byte, Son As Long
 
    Application.ScreenUpdating = False
 
    Alt_Limit = 0
 
    For Each Sayfa In ThisWorkbook.Worksheets
        Sütun = 11 + WorksheetFunction.CountIf(Sayfa.Rows(1), "*Hata*")
        Sayfa.Range("L2:" & Cells(Rows.Count, Sütun).Address(0, 0)).ClearContents
        Son = Sayfa.Cells(Rows.Count, 1).End(3).Row
 
        For Each Hücre In Sayfa.Range("L2:" & Sayfa.Cells(Son, Sütun).Address(0, 0))
            Üst_Limit = (Sayfa.Cells(Hücre.Row, "K") * 0.03) / (WorksheetFunction.CountIf(Sayfa.Rows(1), "*Hata*") / [COLOR=red]1.5[/COLOR])
            Randomize
            Sayı = (Üst_Limit - Alt_Limit) * Rnd() + Alt_Limit
            Hücre.Value = Sayı
        Next
    Next
 
    Application.ScreenUpdating = True
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Kırmızı renkli katsayı ile oynayarak yaklaşık olarak istediğiniz yüzdelere denk getirebilirsiniz.

 

[kamsal]

Merhaba,

Aşağıdaki kodu denermisiniz.

Not : "İz Açma" isimli sayfanızda "Hat 1" gibi değerler var. Bunları "Hata 1" şeklinde düzelttikten sonra kodu çalıştırın.

Sub Düğme1_Tıklat()
    Dim Sayfa As Worksheet
    Dim Alt_Limit As Double
    Dim Üst_Limit As Double
    Dim Sayı As Double
    Dim Sütun As Byte, Son As Long
 
    Application.ScreenUpdating = False
 
    Alt_Limit = 0
 
    For Each Sayfa In ThisWorkbook.Worksheets
        Sütun = 11 + WorksheetFunction.CountIf(Sayfa.Rows(1), "*Hata*")
        Sayfa.Range("L2:" & Cells(Rows.Count, Sütun).Address(0, 0)).ClearContents
        Son = Sayfa.Cells(Rows.Count, 1).End(3).Row
 
        For Each Hücre In Sayfa.Range("L2:" & Sayfa.Cells(Son, Sütun).Address(0, 0))
            Üst_Limit = (Sayfa.Cells(Hücre.Row, "K") * 0.03) / (WorksheetFunction.CountIf(Sayfa.Rows(1), "*Hata*") / [COLOR=red]1.5[/COLOR])
            Randomize
            Sayı = (Üst_Limit - Alt_Limit) * Rnd() + Alt_Limit
            Hücre.Value = Sayı
        Next
    Next
 
    Application.ScreenUpdating = True
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Kırmızı renkli katsayı ile oynayarak yaklaşık olarak istediğiniz yüzdelere denk getirebilirsiniz.

Korhan hocam ekte dosya içinde gösterdiğim hatayı verdi??

 

[Korhan Ayhan]

Merhaba,

Hata oluşan sayfadaki sütun başlıklarını kontrol edin. Bir önceki mesajımdaki "not" olarak belirttiğim hata olabilir.
Yine hata oluşan sayfadaki "K" sütunundaki değeri kontrol edin.

 

[kamsal]

Pardon Korhan hocam,
şimdi işlem tamam hata yok. Size ve leumruk hocama Çok teşekkür ediyorum. Saygı ve Selamlar

 

[kamsal]

Merhaba Korhan Hocam dosyada hata verdi. aşağıdaki hatanın sebebi ne olabilir acaba,

Üst_Limit = (Sayfa.Cells(Hücre.Row, "K") * 0.05) / (WorksheetFunction.CountIf(Sayfa.Rows(1), "*Hata*") / 1.5)