Soru Permütasyon Hesaplama

[Blacklion27]

Merhaba değerli hocalarım diyelim a ve b adında 2 elemanımız var ve bunlar 15 gün karışık bir şekilde çalıştırılacak aşağıdaki excel dosyamdaki örnekteki gibi bu elemanlar kaç değişik şekilde çalışabilirler başlığı permütasyon açtım sanırım öyle bildiğim için sayı söyler ve dosya halini bırakır mısınız? Altın üyeliğim yok internet linki bırakırsanız sevinirim iyi akşamlar

İndir Kitap

Dosyayı indir Kitap

dosya.co

79lZhx.jpg

79lZhx Fotoğrafı, resimleri, fotoğrafları

hizliresim.com

 

[ÖmerFaruk]

Internette konuyla ilgili bulduğum kodları, sizin sorunuzla pekiştirerek aşağıdaki kodları oluşturdum.
Ben 6 güne kadar denedim. 6 günü 8,80 ve 7 günü 20,2 saniyede tamamladı. 15 günü denemedim kasmasın diye.
Bilgisayarınız sağlamsa bir kaç dakikada işlemi tamamlayacaktır.
Örnek dosyayı harici linke de ekledim.
Permutosyon_Dosyasi_Haricilink_silinebilir

Sub BinaryTable()
Zaman = Timer
    Size = Range("B2")
    StartingRow = 2
    RowIndex = StartingRow
    Say = Cells(Rows.Count, 1).End(xlUp).Row
    If Say = 1 Then
        MsgBox "En az 1 isim girmelisiniz"
        Exit Sub
    End If
    If Not IsNumeric(Size) And Size < 1 Or Size > Columns.Count - 3 Then
        MsgBox "Gün Sayısı normal değil"
        Exit Sub
    End If
    Range(Cells(2, 4), Cells(Rows.Count, Columns.Count)).ClearContents
    Application.ScreenUpdating = False

    For i = 0 To (2 ^ Size - 1)
        BinCount = Dec2Bin(i, Size)
        For k = 4 To Size + 3
            Cells(RowIndex, k) = Mid(BinCount, k - 3, 1)
        Next k
        RowIndex = RowIndex + 1
    Next
    Satır = WorksheetFunction.Power(2, Size) + 1
    For i = 2 To Say
        Range(Cells(StartingRow, 4), Cells(Satır, Size + 3)).Replace What:=i - 2, Replacement:=Cells(i, 1)
    Next i
        Application.ScreenUpdating = True
    MsgBox "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
    End Sub

'Decimal To Binary
' =================
' NOTE: You can limit the size of the returned
' answer by specifying the number of bits
Function Dec2Bin(ByVal DecimalIn As Variant, _
    Optional NumberOfBits As Variant) As String
    Dec2Bin = ""
    DecimalIn = Int(CDec(DecimalIn))
    Do While DecimalIn <> 0
    Dec2Bin = Format$(DecimalIn - 2 * Int(DecimalIn / 2)) & Dec2Bin
    DecimalIn = Int(DecimalIn / 2)
    Loop
    If Not IsMissing(NumberOfBits) Then
        If Len(Dec2Bin) > NumberOfBits Then
            Dec2Bin = "Error - Number exceeds specified bit size"
            Else
            Dec2Bin = Right$(String$(NumberOfBits, _
            "0") & Dec2Bin, NumberOfBits)
        End If
    End If