• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Birden Kırkdokuza kadar sayıların Kombinasyonu

korhan bey #13 nolu mesajı öncedende inceledim ama bu revize dosya açmıyor.office picture maneger olarak açıyor ve boş açılıyor.sorun da bu zaten revize dosya açılmıyor..başka bir kaynak yada başka bir program bilginiz dahilindemi..
hemen döndüğünüz için çok taşekürler..iyi geceler efendim
 
arkadaşlar merhaba..
haluk beyin hazırlamış olduğu kombinasyon programı çalışıyor..fakat 1.000.000.sayı ürettikten sonra sistem kaynakları yetersiz uyarısı veriyor.bu program 14 milyona yakın veriyi almak için çalışıyor ama sonradan anladımki exell bu haliyle yetersiz kalıyor verileri saklamak için.exell veri kaynaklarını nasıl arttırayımki yan yana 65 bin satırlara ondörtmilyon olasılığı işlesin..çok büyük bir veri oluyor ama vardır bir çözümü diye düşünüyorum..
cevabınızı bekliyorum...
iyi çalışmalar..
 
Selamlar,

2007 versiyonuna geçerseniz belki sorunu çözebilirsiniz.
 
değerli üstatlar ben 10 numara çekilişi için bir makro arıyorum.aradığım özellikler şunlar:

vereceğim bir aralıktan yine vereceğim sabit bir sayı adedince rastgele birbirinden farklı sayılar üretecek.
Örneğin;
alt değer 1 üst değer 10 ve sabit değer olarak ta 3 girdiğimde,
9 , 3 ,7 gibi rakamları ilk üç sütuna yazacak.Anlatmak istediğim olay eklediğim resimde daha detaylı görülebilir.Yardımcı olursanız minnettar olurum
 

Ekli dosyalar

  • adsız.JPG
    adsız.JPG
    20.6 KB · Görüntüleme: 39
arkadaslar merhaba.
ben 49 un 6 lı kombinasyonunu içeren sizin gönderdiğiniz dosyaları açamıyorum yardımcı olursanız sevinirim.
 
öncelikle slm arkadaşlar siteniz cok güzel ve cok yararlı tşk ederim size.benimde bir sorum olacak ilgilenirseniz tşk bi borç bilirim benim isteyim mümkünse şayet 1 ila 34 rakamın 3 lü konbinasyonunu 5 haneli olarak kurabilirmiyiz yani örnek 1 2 3 4 5 ise 1 2 6 7 8 gibi veya 1 2 3 bi kolonda varsa başka kolonda olmuşcak 1 2 9 bi kolonda varsa başka kolonda olmuşcak
 
"Çalışarak zengin olunsaydı,(söz meclisten dışarı) hamallar zengin olurdu"

Niye "söz meclisten dışarı"? Hamallık ayıp bir şey mi? Gören de hamaldan değil de (söz meclisten dışarı) eşekten veya köpekten bahsediyorsun sanır...
 
Merhaba arkadaşlar,

Buna benzer bir makro çalıştırıyorum.Sonuçları excelde listleiyor fakat sonuç yaklaşık 3m.Tek sayfada 1m satır döküyor debug hatası veriyor.1. sayfa dolduktan sonra devamını yazması için otomatik 2.3.4. sayfayı otomatik oluşturması için nasıl bir kod eklemeliyim.Makro bilgim yok gibi.

Kod: 
Sub Listele()
Dim X As Byte, z As Long
Dim a As Byte, b As Byte, c As Byte, d As Byte, e As Byte, f As Byte, g As Byte
 
X = 49
 
For a = 1 To X
    For b = a + 1 To X
        For c = b + 1 To X
            For d = c + 1 To X
                For e = d + 1 To X
                    For f = e + 1 To X
                            z = z + 1
                            Cells(z, 1) = a
                            Cells(z, 2) = b
                            Cells(z, 3) = c
                            Cells(z, 4) = d
                            Cells(z, 5) = e
                            Cells(z, 6) = f
                    Next f
                Next e
            Next d
        Next c
    Next b
Next a
 
End Sub
 
badboy_ercu' Alıntı:
Merhaba arkadaşlar,

Buna benzer bir makro çalıştırıyorum.Sonuçları excelde listleiyor fakat sonuç yaklaşık 3m.Tek sayfada 1m satır döküyor debug hatası veriyor.1. sayfa dolduktan sonra devamını yazması için otomatik 2.3.4. sayfayı otomatik oluşturması için nasıl bir kod eklemeliyim.Makro bilgim yok gibi.
Genişletmek için tıkla ...

Merhaba
Kodlarınızı aşağıdaki gibi düzenleyip deneyin. (Kodlarda sayfalar "1" den başlayacağı için dosya yeni olsun)
Kod: 
[SIZE="2"]Sub Listele()
Dim z As Long
Dim a As Byte, b As Byte, c As Byte, d As Byte, e As Byte, f As Byte, g As Byte
 Dim s1 As Worksheet
s = 1
 Set s1 = Sheets(s)
For a = 1 To 44


    For b = a + 1 To 45
        For c = b + 1 To 46
            For d = c + 1 To 47
                For e = d + 1 To 48
                    For f = e + 1 To 49
If z = 1000001 Then
z = 0: s = s + 1
If Sheets.Count < s Then Sheets.Add After:=Sheets(Sheets.Count)
Set s1 = Sheets(s)
s1.Activate
End If
                            z = z + 1
                            s1.Cells(z, 1) = a
                            s1.Cells(z, 2) = b
                            s1.Cells(z, 3) = c
                            s1.Cells(z, 4) = d
                            s1.Cells(z, 5) = e
                            s1.Cells(z, 6) = f
                            s1.Cells(z, 1).Select
                    Next f
                Next e
            Next d
        Next c
    Next b
Next a
 
End Sub

 [/SIZE]
 
Son düzenleme:
sıfırdan dosya açtım verdiğiniz kodları makro olarak modüle yazdım excelde.Fakat değişen hiçbirşey olmadı 1 sayfa yazıyor. 1m lik satır dolunca debug hatası veriyor devamını ek sayfalar oluşturup yazmıyor.

PLİNT' Alıntı:
Merhaba
Kodlarınızı aşağıdaki gibi düzenleyip deneyin. (Kodlarda sayfalar "1" den başlayacağı için dosya yeni olsun)
Kod: 
[SIZE="2"]Sub Listele()
Dim z As Long
Dim a As Byte, b As Byte, c As Byte, d As Byte, e As Byte, f As Byte, g As Byte
[COLOR="Blue"] Dim s1 As Worksheet
s = 1[/COLOR]
 [COLOR="Blue"]Set s1 = Sheets(s)[/COLOR]
For a = 1 To [COLOR="Blue"]44[/COLOR]

[COLOR="Blue"]If z = 1000001 Then
z = 0: s = s + 1
If Sheets.Count < s Then Sheets.Add After:=Sheets(Sheets.Count)
End If[/COLOR]
    For b = a + 1 To [COLOR="Blue"]45[/COLOR]
        For c = b + 1 To [COLOR="Blue"]46[/COLOR]
            For d = c + 1 To [COLOR="Blue"]47[/COLOR]
                For e = d + 1 To [COLOR="Blue"]48[/COLOR]
                    For f = e + 1 To [COLOR="Blue"]49[/COLOR]
                            z = z + 1
                            [COLOR="Blue"]s1[/COLOR].Cells(z, 1) = a
                            [COLOR="Blue"]s1[/COLOR].Cells(z, 2) = b
                            [COLOR="Blue"]s1.[/COLOR]Cells(z, 3) = c
                            [COLOR="Blue"]s1.[/COLOR]Cells(z, 4) = d
                            [COLOR="Blue"]s1.[/COLOR]Cells(z, 5) = e
                            [COLOR="Blue"]s1.[/COLOR]Cells(z, 6) = f
                            [COLOR="Blue"]s1.Cells(z, 1).Select[/COLOR]
                    Next f
                Next e
            Next d
        Next c
    Next b
Next a
 
End Sub
 [/SIZE]
Genişletmek için tıkla ...
 
badboy_ercu' Alıntı:
sıfırdan dosya açtım verdiğiniz kodları makro olarak modüle yazdım excelde.Fakat değişen hiçbirşey olmadı 1 sayfa yazıyor. 1m lik satır dolunca debug hatası veriyor devamını ek sayfalar oluşturup yazmıyor.
Genişletmek için tıkla ...
Sayfa ekleyen bölümün yeri yanlış olmuş,
yukarıdaki (51.mesaj) değişen şekliyle deneyin
 
Gerçekten Çok teşekkür ederim bu sanırım işimi çözecek.1. Aşama tamam.

Peki birde şöyle birşey yapmak istiyorum.O konu hakkında da sizden yardım alabilirsem çok sevinirim.

1 2 3 4 5 6
...............
..................
1 2 3 4 48 49
1 2 3 5 6 7

olarak devam ediyor normal şartlarda.Ben diyorumki son sayıdan sonra örnekteki gibi başa döndüğünde 7 olarak değilde benim bleirleyeceğim örneğin 20 den başlayıp 21 22 ... 49 gibi devam etsin.

biraz daha netleştirecek olursak a b c d e f şeklinde 6 sütunumuz var.
Son sütün 6-49 arası rakamlar dönüyor.Onun yerine ben bunun 20-49 arası dönmesini istiyorum.

1 2 3 5 6 20 ... bu hale geldğindede 20-20 olmaması için +1 devam etmesini istiyorumyani:
1 2 3 5 6 20 21 gibi
eklemem gereken kodlar ne şekilde ve nelerdir ?

PLİNT' Alıntı:
Sayfa ekleyen bölümün yeri yanlış olmuş,
yukarıdaki (51.mesaj) değişen şekliyle deneyin
Genişletmek için tıkla ...
 
For f = e + 1 To 49 burda e yerine sayı girersiniz olur.
 
Dediğiniz şekilde yapıldığında

1 2 3 4 21 21

ya da

1 2 3 4 21 20

gibi sonuçlarda ortaya çıkıyor.Böyle olmaması lazım.Bir öncekine eşit yada düşük değer olamaz o zaman kombinasyon olmaz zaten.Sayıların benzersiz olması lazım.

Bunun yerine

1 2 3 4 5 20
1 2 3 4 5 21 olarak devam ederken

1 2 3 4 2021 gibi
ya da

1 2 3 4 21 22 olarak deam etmeli.

YANLIŞ : 1 2 3 4 20 19 , 1 2 3 4 20 20 ,

askm' Alıntı:
For f = e + 1 To 49 burda e yerine sayı girersiniz olur.
Genişletmek için tıkla ...
 
Son döngüde f değeri en küçük 6 en büyük 49 olacağından
f=6 iken; e = 5 olacağını düşünerek

For f = 14 + e + 1 To 49

e değeri ni artırırsanız (5. kolonu)
For e = 14 + d + 1 To 48

gibi yukarı doğru devam edebilirsiniz

sayısal lotoda
Şimdiye kadar 1. kolonda 30 dan yukarı rakam olmadı
6. kolonda 18 den aşağı olmadı
böyle düşünerek 2,3,4 kolonların durumunu da göz önüne alarak eleme yapabilirsiniz.
 
Son düzenleme:
Bu seferde şöyle bir şey ortaya çıkıyor

1 2 3 4 5 20
................
....
1 2 3 4 5 49
1 2 3 4 6 21 - hatalı

e sütunundaki sayı 6 ya atladığı zaman f tekrar 20 den başlaması gerekirken 21 den başlıyor yani 1 artıyor.

1 2 3 4 5 49 sonrası
1 2 3 4 6 20 olarak devam etmesi gerekmekte.



PLİNT' Alıntı:
Son döngüde f değeri en küçük 6 en büyük 49 olacağından
f=6 iken; e = 5 olacağını düşünerek

For f = 14 + e + 1 To 49

e değeri ni artırırsanız (5. kolonu)
For e = 14 + d + 1 To 48

gibi yukarı doğru devam edebilirsiniz

sayısal lotoda
Şimdiye kadar 1. kolonda 30 dan yukarı rakam olmadı
6. kolonda 18 den aşağı olmadı
böyle düşünerek 2,3,4 kolonların durumunu da göz önüne alarak eleme yapabilirsiniz.
Genişletmek için tıkla ...
 
Aşağıdaki gibi olurmu?
Kod: 
[SIZE="2"]            For d = c + 1 To 47
                For e = d + 1 To 48
           [COLOR="Blue"]   g = IIf(e < 20, 20, e + 1)
                    For f = g To 49[/COLOR]
If z = 1000001 Then [/SIZE]


Baştaki döngülere doğru

Kod: 
[SIZE="2"]s = 1
 Set s1 = Sheets(s)
[COLOR="Blue"]For a = 1 To 44
g = IIf(a < 16, 16, a + 1)
    For b = g To 45
    g1 = IIf(b < 17, 17, b + 1)
        For c = g1 To 46
        g2 = IIf(c < 18, 18, c + 1)
            For d = g2 To 47
            g3 = IIf(d < 19, 19, d + 1)
                For e = g3 To 48
              g4 = IIf(e < 20, 20, e + 1)
                    For f = g4 To 49[/COLOR]
If z = 1000001 Then
z = 0: s = s + 1 [/SIZE]
 
bunu süper lotoya nasıl uyarlayabilirim?

49 yerine 54 yazdım. 21 milyona gelince debug hatası veriyor. exel 2010 kullanıyorum


Necdet Yeşertener' Alıntı:
Karışık nasıl olur bilemiyorum ama sayıları birleştirerek her kolona 60.000 olasılık yazdırdım.

Ne işe yarıyacağını da merak ettim doğrusu.

Kod: 
Sub Hesapla()
Adet = 49
Kolon = 1
Sıra = 1
Satır = 1
For s1 = 1 To Adet - 5
    For s2 = s1 + 1 To Adet - 4
        For s3 = s2 + 1 To Adet - 3
            For s4 = s3 + 1 To Adet - 2
                For s5 = s4 + 1 To Adet - 1
                    For s6 = s5 + 1 To Adet - 0
 
                        Cells(Satır, Kolon).Value = Sıra & "--) " & _
                                s1 & "-" & s2 & "-" & s3 & "-" & _
                                s4 & "-" & s5 & "-" & s6
                        Sıra = Sıra + 1
                        Satır = Satır + 1
                        If Satır > 60000 Then
                            Satır = 1
                            Kolon = Kolon + 1
                        End If
 
                    Next s6
                Next s5
            Next s4
        Next s3
    Next s2
Next s1
Mesaj = "HESAPLAMA İŞLEMİ TAMAMDIR "
End Sub
Genişletmek için tıkla ...
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst