Sayısal Loto

[Necdet]

Merhaba arkadaşlar,

Kumarla aram pek iyi değildir ama, makroyu öğrenmek amacıyla kendime basit bir konu bularak çalışmaya başladım.

Sayısal lotodaki amaç sistemli oynamak. Rastgele sayılarla oynamaktan sa sistemli ama az kolanla oynamayı bulmaya çalışan bir program yapmaya çalıştım.

Örneğin, 9 sayı seçip bunların tüm olasılıklarını oynamak için 84 kolon gerekli, oysa 5 garantili oynarsanız bu sayı 8 kolona düşüyor. Bunları yaptım.

Eğer çekilişteki numaraları ve ikramiye tutarlarını girerseniz ne kadar ikramiye alacağını da buluyor.

Yapamadığım konu : Çekiliştike numaraları karışık ta girsem sıralattırabildim ama, Tahmin sayılarını sıralatamadım, incelerseniz sevinirim.

Sayfa Koruması = 1 dir.

Bol şanslar

 

[szaim]

SayınNecdet_Yesertener,
Gerçekten kumar kötüdür..
Güzel bir çalışma olmuş..
Makrolardan örnekler alabiliriz. Teşekkür ederim..

 

[Levent Menteşoğlu]

T.[a2:a16].Sort Key1:=T.[A2]

yerine aşağıdaki yazım şeklini;

T.[a2:a16].Sort Key1:=T.[A2] , Orientation:=xlTopToBottom

T.Range("J3:O3").Sort Key1:=T.Range("J3")

yerinede aşağıdaki yazım şeklini kullanın. İlaveler sıralamanın yönünü belirtmektedir.

.Range("J3:O3").Sort Key1:=T.Range("J3") , Orientation:=xlLeftToRight

 

[Necdet]

Sayın szaim, teşekkür ederim, aslında basit bir konu şu an yaptığım, daha önce yaptığımda (ki Cobol ile yapmıştım) herşey parametrikti sayıları elemek için akla gelmeyen yöntemler bulmuştum. (örneğin ardışık şu kadar sayı olamaz, tek sayıların sayısı şu kadar olsun). Şu sayılar banko olsun gibi

Hatta daha ileri gidip loto kuponunu bile yazıdan doldurturuyordum.

Şimdi bana VBA biraz yabancı o yüzden bu çalışmayı seçtim. İleride daha güzel şeyler yapabilme ümidim var, Saygılar

 

[Necdet]

Teşekkürler leventm

 

[Recep İpek]

Sayın Necdet_Yesertener

Örnek olması açısından internetten bulduğum daha sonrada çeşitli ilaveler yaptığım kodları aşağıda bulabilirsiniz.

Kolay Gelsin.

Sub SLoto()
Dim data As Variant
data = UniqueRandomNumbers(6, 1, 49) ' 1 ile 49 arasında rastgele 6 sayı
sonuc = data(1) & " " & data(2) & " " & data(3) & " " & data(4) & " " & data(5) & " " & data(6)
MsgBox "Sayısal Loto Numaranız:" & vbNewLine & vbNewLine & " " & sonuc, vbInformation + vbDefaultButton1 + vbOKOnly, "SAYISAL LOTO"
End Sub
 
Function UniqueRandomNumbers(NumCount As Long, LLimit As Long, ULimit As Long) As Variant
' creates an array with NumCount unique long random numbers in the range LLimit - ULimit (including)
Dim RandColl As Collection, i As Long, varTemp() As Long
 
UniqueRandomNumbers = False
 
If NumCount < 1 Then Exit Function
If LLimit > ULimit Then Exit Function
If NumCount > (ULimit - LLimit + 1) Then Exit Function
Set RandColl = New Collection
Randomize
Do
On Error Resume Next
i = CLng(Rnd * (ULimit - LLimit) + LLimit)
RandColl.Add i, CStr(i)
On Error GoTo 0
Loop Until RandColl.Count = NumCount
 
ReDim varTemp(1 To NumCount)
 
For i = 1 To NumCount
varTemp(i) = RandColl(i)
Next i
'**************ripek********************
For i = 1 To NumCount - 1
For j = i + 1 To NumCount
If varTemp(i) > varTemp(j) Then
k = varTemp(i)
varTemp(i) = varTemp(j)
varTemp(j) = k
End If
Next j
Next i
'**************ripek********************
Set RandColl = Nothing
UniqueRandomNumbers = varTemp
Erase varTemp
'*****[URL="http://www.excel.web.tr***********"]www.excel.web.tr***********[/URL]
End Function

 

[Necdet]

Sayın ripek, güzel çalışma tebrikler.

İsteğimize göre 6-15 adet arasında rastgele sayı üretir hale getirmek olası mı?
Kaç adet sayı üreteceğimizi sorsun ve o kadar sayı üretsin.

Parametrik olması açısından güzel olur.

 

[Recep İpek]

Sayın Necdet_Yesertener,

Uzun uğraşılarıma rağmen Fonsiyonu parametrik yapamadım.
Sanırım değişken tipi Long tanımlandığı için olmuyor.

Eğer 6-15 arasında sayı üretmek istiyorsanız aşağıdaki kodları deneyebilirsiniz.

Sub SLoto()
On Error Resume Next
Dim data, k As Variant
Dim adet, ilk, son As Long
'adet = InputBox("Adet")
'ilk = InputBox("İlk")
'son = InputBox("Son")
'data = UniqueRandomNumbers(adet, ilk, son)
 
data = UniqueRandomNumbers(6, [COLOR=red]6, 15[/COLOR])
For k = 1 To 6
Cells(1, k).Value = data(k)
Next k
End Sub

 

[Necdet]

Sayın ripek, sanırım beni yanlış anladınız.

1-49 sayı arasında istediğim adet kadar sayı üretmesini istiyorum.

örneğin 9 adet sayı üretmesini istersem, ben bu 9 adet sayıyı 6 lı kombine yaparak 84 kolon üretmek istiyorum.

Yoksa sadece 6 ile 15 sayı arasında rastgele sayı istemiyorum.

 

[Recep İpek]

Sayın Necdet_Yesertener

İşlerimin yoğunluğu nedeni ile foruma bakma fırsatım olmadı.

Anladığım kadarıyla (matematik'le aramın pek iyi olmadığı için )
1 ile 49 arasında herhangi bir 9 adet sayı belirleyip bunların 6'lı kombinasyonunun bulunmasını istiyorsunuz.

Yani en çok çıkan sayılarla oynamak için.

Sorunuz bu ise gerçekten çok güzel olur.Bende bunun üzerinde çalışacağım.

Kolay Gelsin

 

[Necdet]

Evet Sayın ripek, soruyu doğru anlamışsınız, ama sadece 9 sayı ile sınırlı kalmamalı, 15 adet sayıya kadar çıkabilmeli.

Bu arada dosyanın düzeltilmiş halini de ekleyim.

 

[dost]

Sayın Yesertener,

Dosya ektedir. İnceleyiniz.

 

[Recep İpek]

Sonunda uzun uğraşlardan sonra bitirebildim.

Sayısal Loto için örnek olabilecek dosyayı ekte bulabilirsiniz.

Burada istediğiniz sayılara göre sizlere rastgele sayılar üretmektedir.

Şimdi rahat rahat uyuyabilirim. :uyku:

İyi geceler.

Not:Umarım arkadaşlara kötü örnek teşkil etmiyorumdur.
Çünkü kumarı hiç sevmem.Burada yapılanlarının hepsi excel bilgilerimizi daha da geliştirmek için.

 

[xlsx]

Dosyalar nerede

Sonunda uzun uğraşlardan sonra bitirebildim.

Sayısal Loto için örnek olabilecek dosyayı ekte bulabilirsiniz.

Burada istediğiniz sayılara göre sizlere rastgele sayılar üretmektedir.

Şimdi rahat rahat uyuyabilirim. :uyku:

İyi geceler.

Not:Umarım arkadaşlara kötü örnek teşkil etmiyorumdur.
Çünkü kumarı hiç sevmem.Burada yapılanlarının hepsi excel bilgilerimizi daha da geliştirmek için.

Arkadaşlar
Tam da benim aradığım uygulama ama dosyayı göremiyorum.Eklemeniz mümkün mü? Bu dosyaya ihtiyacım olacak

 

[Levent Menteşoğlu]

Dosyalar ilgili yerlerine tekrar yüklenmiştir.

 

[adslboy]

Sonunda uzun uğraşlardan sonra bitirebildim.

Sayısal Loto için örnek olabilecek dosyayı ekte bulabilirsiniz.

Burada istediğiniz sayılara göre sizlere rastgele sayılar üretmektedir.

Şimdi rahat rahat uyuyabilirim. :uyku:

İyi geceler.

Not:Umarım arkadaşlara kötü örnek teşkil etmiyorumdur.
Çünkü kumarı hiç sevmem.Burada yapılanlarının hepsi excel bilgilerimizi daha da geliştirmek için.

Sayin Recep ipek tam da uzun zamandir bolesi bir uygulamayi ariyordum tekrar gondermeniz mumkunmu Saygilar

 

[serseri26]

Dosyalar ilgili yerlerine tekrar yüklenmiştir.

merhaba hocam doyalar indirilemiyor sorun nedir?

 

[oqsijen]

Hocam bu dosyayı tekrar yükleme şansınız varmı lütfen ilgilenin