Kombinasyon işlemleri

[BYSERTTAS]

Arkadaşlar sayısal loto kombinasyonu yapmak istiyorum. Elinde örnek dosya olan varsa paylaşa bilirmisiniz.

 

[Necdet]

Merhaba,

Yol yakınken vaz geçin derim

 

[BYSERTTAS]

Amacım kombinasyon yapmayı öğrenmek. Sayısal isin bahanesi 14milyonda bir ihtimal ihtimal değildir onu biliyorum.tavsiyeniz için tesekkurler

 

[Ömer]

Merhaba,

Linki inceleyiniz.

Kombinasyon sonucunu sayfalara yazdırabilirmiyiz

Selam Excelde kombinasyon sonucunu sayfalara yazdırabilirmiyiz örneğin 20 ismin 3 erli kombinasyonu 1140 adet oluyor VBA kodlarıyla veya başka bir yöntemle bu 1140 adet 3 erli ismi sayfaya/sayfalara yazdırabilirmiyiz

www.excel.web.tr

.

 

[Necdet]

Merhaba Yine,

Forumda bu konu çok işlendi, Fakat Özyinelemeli olarak pek örneğini göremedim.

O yüzden dosya paylaşıyorum.

Kodları bir modüle kopyalayıp deneyiniz.

Public Sonuc() As Variant

Sub Basla()

    Dim i As Integer
    i = Cells(Rows.Count, "A").End(3).Row
    
    If i < 2 Then
        MsgBox "A Sütununa Verileri Girmemişsiniz...."
        Exit Sub
    End If
    
    If IsNumeric(Range("B2")) = False Or Range("B2") = 0 Then
        MsgBox "B2 Hücresine Kaçlı Kombinasyon Olacağını Belirtmemişsiniz....", vbCritical
        Exit Sub
    End If
    
    If Range("B2") >= Range("C2") Then
        MsgBox "B2 Hücre Değeri C2 Hücre Değerinden Küçük Olmalı", vbCritical
        Exit Sub
    End If
    
    Komb Range("A2:A" & i), Range("B2"), Range("F2")
    
End Sub

Sub Komb(Rng As Range, Sec As Single, Hdf As Range)

    Dim rn As Variant
    
    rn = Rng.Value
    
    Hdf.CurrentRegion.Offset(1, 0).ClearContents
    
    ReDim Sonuc(Sec - 1, 0)
    
    Call Özyinele(rn, Sec, 1, 0)
    
    Hdf.Resize(UBound(Sonuc, 2), UBound(Sonuc, 1) + 1) = Application.Transpose(Sonuc)
    Hdf.CurrentRegion.Offset(1, 0).Columns.AutoFit

End Sub

Function Özyinele(r As Variant, c As Single, d As Single, e As Single)

    Dim f As Single
    Dim g As Integer

    For f = d To UBound(r, 1)
    
        Sonuc(e, UBound(Sonuc, 2)) = r(f, 1)
    
        If e = (c - 1) Then
            ReDim Preserve Sonuc(UBound(Sonuc, 1), UBound(Sonuc, 2) + 1)
            For g = 0 To UBound(Sonuc, 1)
                Sonuc(g, UBound(Sonuc, 2)) = Sonuc(g, UBound(Sonuc, 2) - 1)
            Next g
        Else
            Call Özyinele(r, c, f + 1, e + 1)
        End If
        
    Next f
    
End Function

 

[Necdet]

Konu ağır geldi galiba, ses seda çıkmayınca

 

[Tevfik_Kursun]

Elinize sağlık Necdet Hocam,
paylaşım için teşekkürler, güzel bir çalışma