DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
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