Tombala türü çekiliş sistemi

[dodopali]

Değerli excel web tr forum üyeleri ve site yöneticilerine tekrardan merhaba...
aşağı yukarı 6 aydır bu sorunuma çözüm bulunamadı sitede...
elimde 24 adet sayı var bu sayılar 12 şerli olarak 2 gruba ayrılmıştır..
bu sayıları kullanarak haftalık bir çekiliş gerçekleştirmek istiyorum istediğim düzen şu..
1. sayılar sürekli farklı satırlarda olacak yani bir sayı aynı satırda sadece bir kere kullanılacak..
2. bir sayının hemen altındaki satıra denk gelen sayı bir başka satırda altına denk gelmeyecek hepsi bu.. aşağıdaki ekli dosya jpg ve excel de belirttim..
bu isteklerimi tombala sistemini kullarak gerçekleştirmek istiyorum düğmeye basıcam ve iş bitecek...
böyle bir makro yazılabilirmi...

 

[uzmanamele]

Değerli excel web tr forum üyeleri ve site yöneticilerine tekrardan merhaba...
aşağı yukarı 6 aydır bu sorunuma çözüm bulunamadı sitede...
elimde 24 adet sayı var bu sayılar 12 şerli olarak 2 gruba ayrılmıştır..
bu sayıları kullanarak haftalık bir çekiliş gerçekleştirmek istiyorum istediğim düzen şu..
1. sayılar sürekli farklı satırlarda olacak yani bir sayı aynı satırda sadece bir kere kullanılacak..
2. bir sayının hemen altındaki satıra denk gelen sayı bir başka satırda altına denk gelmeyecek hepsi bu.. aşağıdaki ekli dosya jpg resimde de belirttim..
bu isteklerimi tombala sistemini kullarak gerçekleştirmek istiyorum düğmeye basıcam ve iş bitecek...
böyle bir makro yazılabilirmi...

merhaba

böyle bir makro yazılabilir.
sizin yerinize örnek dosyayı da arkadaşlarımızın hazırlamasını bekliyorsanız 6 ay yetmez!

 

[dodopali]

sizede merhaba sayın uzmanamele sitedeki aşağı yukarı tüm dosyaları inceledim bana yarıyabilecek olanlarada baktım ve hepsinde dosyayı sitedeki arkadaşlarımız hazırlayıp sunmuş yardımcı olmuşlar ne ima etmeye çalıştığınızı anlamadım elimden birşeyler gelse zaten ona göre konuyu açardım....
elinizden geliyorsa yardımlarınızı bekliyorum saygılar..

 

[uzmanamele]

sizede merhaba sayın uzmanamele sitedeki aşağı yukarı tüm dosyaları inceledim bana yarıyabilecek olanlarada baktım ve hepsinde dosyayı sitedeki arkadaşlarımız hazırlayıp sunmuş yardımcı olmuşlar ne ima etmeye çalıştığınızı anlamadım elimden birşeyler gelse zaten ona göre konuyu açardım....
elinizden geliyorsa yardımlarınızı bekliyorum saygılar..

merhaba
syn dodopali,
sorunuzu örnek dosya ile destekleyiniz.

 

[dodopali]

merhaba
syn dodopali,
sorunuzu örnek dosya ile destekleyiniz.

ekledim dosyayı sayın uzmanamele...

 

[dodopali]

konunun başlığını değiştiren admine teşekkür ederim fakat ben dikkat çeksin diye yazdım eski başlığı zira kimsenin ilgilendiği falan yok çünkü.

 

[dodopali]

*-*-*-*-*-*-*
*-*-*-*-*
*-*-*-
*-*
*

 

[leumruk]

Merhaba,
Aşağıdaki örneği deneyiniz. Yalnız istediğiniz, kriterlere uygun sıralamayı bulması uzun sürebiliyor, biraz beklemeniz gerekebilir.

Sub HücreSeç()
[a3:a14].Copy Range("f3,h3,j3,l3,g15,ı15,k15")
[a15:a26].Copy Range("f15,h15,j15,l15,g3,ı3,k3")

İlk = 3
Son = 14
For w = 1 To 2
For q = 6 To 12
Randomize
Dim varArr As Variant, varTemp As Variant
Dim random As Range
Dim x As Long, y As Long
Set random = Sheets("TMBL").Range(Cells(İlk, q), Cells(Son, q))
varArr = random.Value
Randomize
For x = 1 To UBound(varArr, 1)
    y = Int(Rnd() * UBound(varArr) + 1)
    varTemp = varArr(x, 1)
    varArr(x, 1) = varArr(y, 1)
    varArr(y, 1) = varTemp
Next x
random.Value = varArr
Next q
İlk = İlk + 12
Son = Son + 12
Next w
Call Kontrol
End Sub

Sub Kontrol()
On Error Resume Next
İlkSut = 6
For t = 1 To 2
İlk = 3
Son = 13
  For k = 1 To 2
    For S1 = İlkSut To 12 Step 2
      If S1 >= 11 Then GoTo Bitir
        For i = İlk To Son
          For j = İlk To Son
            If Cells(i, S1) = Cells(j, S1 + 2) And Cells(i + 1, S1) = Cells(j + 1, S1 + 2) Then
              Cells(i, S1).Interior.ColorIndex = 3
              Cells(j, S1 + 2).Interior.ColorIndex = 3
              Cells(i + 1, S1).Interior.ColorIndex = 3
              Cells(j + 1, S1 + 2).Interior.ColorIndex = 3
              Call HücreSeç
            End If
          Next
        Next
      Next
Bitir:
      İlk = İlk + 12
      Son = Son + 12
  Next k
  İlkSut = İlkSut + 1
Next t
End Sub

İlk eklediğim kod, sayıları rastgele karıştırıyor ve sonunda 2. eklediğim kontrol makrosunu çalıştırıyor. Kontrol makrosu sayı sıralanışını kontrol ediyor. Eğer kritere uygunsa işlem sonlanıyor; değilse sıralama yeniden çalışıyor. Bu şekilde sonuca ulaşana kadar makro sürekli çalışıyor.

 

[dodopali]

çalışmanız güzel olmuş sayın leumruk evet dediğiniz gibi çalışması uzun sürüyor makronun ayrıca tamda istediğim gibi olmamış çünkü aynı satıra aynı sayılar denk gelmiş ve bir sayının hemen altındaki satıra denk gelen sayı tekrar başka bir gün denk gelmiş bunu düzeltebilirmiyiz.demek istediğim durumun jpg resmini ekledim..
bütün herşey için teşekkür ederim saolun ilginiz için..iyi günler..

 

[dodopali]

*-*-*-*-
*-*-*-
*-*-
*-
*

 

[dodopali]

yokmu bi çaresi bu işin

 

[dodopali]

:d:d:d:d
:d:d:d
:d:d
:d

 

[dodopali]

:yardim::yardim::yardim::yardim:
:yardim::yardim::yardim:
:yardim::yardim:
:yardim:

 

[leumruk]

yokmu bi çaresi bu işin

Syn. dodopali,
Sayı aralığı sınırlı, gerçekleştirilecek şart sayısı sayı aralığına göre fazla. Yani ihtimali tutturmak çok zor. Belki de yüzde 5'lik bir ihtimali yakalamaya çalışıyoruz.
İlk belirttiğiniz şartı yakalayabiliriz. (Alt alta aynı sayıların tekrar etmemesi şartı)
Diğer şartınızı da eklersek nasıl bir sonuç çıkar bilemiyorum? (Aynı satıra aynı sayının denk gelmemesi.)

 

[dodopali]

Syn. dodopali,
Sayı aralığı sınırlı, gerçekleştirilecek şart sayısı sayı aralığına göre fazla. Yani ihtimali tutturmak çok zor. Belki de yüzde 5'lik bir ihtimali yakalamaya çalışıyoruz.
İlk belirttiğiniz şartı yakalayabiliriz. (Alt alta aynı sayıların tekrar etmemesi şartı)
Diğer şartınızı da eklersek nasıl bir sonuç çıkar bilemiyorum? (Aynı satıra aynı sayının denk gelmemesi.)

syn leumruk evet dediğiniz doğru olabilir zor ve düşük bir ihtimal işte bende bundan dolayı işin içinden çıkamıyorum...
aslında şöyle birşey yapılabilirmiki acaba sayıları 2şerli veya 3erli atlatarak satırlara yazdırsak alt alta denk gelme ihtimalini düşürebilirmiyiz..
zor bir durum yardımlarınız için teşekkür ederim çok saolun...birşey çıkartabilirseniz çok memnun kalcam iyi günler..

 

[leumruk]

syn leumruk evet dediğiniz doğru olabilir zor ve düşük bir ihtimal işte bende bundan dolayı işin içinden çıkamıyorum...
aslında şöyle birşey yapılabilirmiki acaba sayıları 2şerli veya 3erli atlatarak satırlara yazdırsak alt alta denk gelme ihtimalini düşürebilirmiyiz..
zor bir durum yardımlarınız için teşekkür ederim çok saolun...birşey çıkartabilirseniz çok memnun kalcam iyi günler..

Alt alta gelmeme şartını çözdüm. Onda problem yok. Sorun sonradan eklediğiniz ikinci şartta. Yani aynı satıra aynı sayının gelmemesi ihtimali, bu şartı da ekleyince döngü dönüp duruyor. Sonu gelmiyor.
Eğer ikinci şarttan vazgeçerseniz, diğer şarta göre düzenlediğim dosyayı ekleyeyim.

 

[dodopali]

Alt alta gelmeme şartını çözdüm. Onda problem yok. Sorun sonradan eklediğiniz ikinci şartta. Yani aynı satıra aynı sayının gelmemesi ihtimali, bu şartı da ekleyince döngü dönüp duruyor. Sonu gelmiyor.
Eğer ikinci şarttan vazgeçerseniz, diğer şarta göre düzenlediğim dosyayı ekleyeyim.

tamam bir ekleyin bende bakayım denemeler yapayım kaç sayı aynı satırı tekrar ediyor...

 

[leumruk]

Merhaba,
Dosya ekte. Tablo şeklinde ufak bir değişiklik yaptım.

 

[dodopali]

Merhaba,
Dosya ekte. Tablo şeklinde ufak bir değişiklik yaptım.

güzel olmuş sayın leumruk elinize sağlık yanyana denk gelme ihtimalide çözülebilmiş olsaydı harika olacakdı herşey için teşekkürler ...

 

[leumruk]

Onun makrosuda hazır; ancak sonuca götürür mü bilemiyorum. İsterseniz o şartıda ekleyeyim.
Ama saatlerce beklemniz gerekebilir. Şartın sağlanıp sağlanmayacağı da şüpheli.