Results 1 to 7 of 7

Thread: Combination And Permutation with no repeat
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    Board Regular
    Join Date
    Mar 2019
    Posts
    204
    Post Thanks / Like
    Mentioned
    2 Post(s)
    Tagged
    0 Thread(s)

    Default Combination And Permutation with no repeat

    Thanks in advance

    in column "A", i have the numbers, suppose it is 0 to 99

    (1) Now i want the list of generated numbers through combination with no repeats in the set of 5, please provide any vba code

    (2) I want the list of generated numbers through permutation with no repeats in the set of 5, please provide any vba code

    pls provide.

  2. #2
    Board Regular Worf's Avatar
    Join Date
    Oct 2011
    Location
    Rio, Brazil
    Posts
    3,729
    Post Thanks / Like
    Mentioned
    6 Post(s)
    Tagged
    2 Thread(s)

    Default Re: Combination And Permutation with no repeat

    Excel 2013 / Windows 8.1 (home)
    Excel 2013 / windows 7 (work)


  3. #3
    Board Regular
    Join Date
    Mar 2019
    Posts
    204
    Post Thanks / Like
    Mentioned
    2 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Combination And Permutation with no repeat

    Thanks bro

  4. #4
    Board Regular
    Join Date
    Mar 2019
    Posts
    204
    Post Thanks / Like
    Mentioned
    2 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Combination And Permutation with no repeat

    hi,

    i have tried but its showing error

    using the following sheet

    Col 1 Col 2
    p 10
    Combinations FALSE
    Repetition TRUE
    Set 0
    1
    2
    3
    4
    5
    6
    7
    8
    9

    using this code

    Option Explicit


    ' PGC Set 2007
    ' Calculates and writes the Combinations / Permutations with/without repetition
    ' Assumes the result is written from row 1 down. If the total number of cells in a column
    ' is less than tha number of results continues in another group of columns to the right.
    ' vElements - Array with the set elements (1 to n)
    ' p - number of elements in 1 combination/permutation
    ' bComb - True: Combinations, False: Permutations
    ' bRepet - True: with repetition, False: without repetition
    ' vResult - Array to hold 1 permutation/combination (1 to p)
    ' lRow - row number. the next combination/permutation is written in lRow+1
    ' vResultAll - Array to hold all the permutations/combinations (1 to Total, 1 to p)
    ' iElement - order of the element to process in case of combination
    ' iIndex - position of the next element in the combination/permutation

    ' Sub CombPerm() deals with the input / output
    ' Sub CombPermNP() generates the combinations / permutations

    Sub CombPerm()
    Dim rRng As Range, p As Integer
    Dim vElements As Variant, vResult As Variant, vResultAll As Variant, lTotal As Long
    Dim lRow As Long, bComb As Boolean, bRepet As Boolean
    Dim vResultPart, iGroup As Integer, l As Long, lMax As Long, k As Long

    ' Get the inputs and clear the result range (you may adjust for other locations)
    Set rRng = Range("B5", Range("B5").End(xlDown)) ' The set of numbers
    p = Range("B1").Value ' How many are picked
    bComb = Range("B2")
    bRepet = Range("B3")
    Range("D1", Cells(1, Columns.Count)).EntireColumn.Clear

    ' Error
    If (Not bRepet) And (rRng.Count < p) Then
    MsgBox "With no repetition the number of elements of the set must be bigger or equal to p"
    Exit Sub
    End If

    ' Set up the arrays for the set elements and the result
    vElements = Application.Index(Application.Transpose(rRng), 1, 0)
    With Application.WorksheetFunction
    If bComb = True Then
    lTotal = .Combin(rRng.Count + IIf(bRepet, p - 1, 0), p)
    Else
    If bRepet = False Then lTotal = .Permut(rRng.Count, p) Else lTotal = rRng.Count ^ p
    End If
    End With
    ReDim vResult(1 To p)
    ReDim vResultAll(1 To lTotal, 1 To p)

    ' Calculate the Combinations / Permutations
    Call CombPermNP(vElements, p, bComb, bRepet, vResult, lRow, vResultAll, 1, 1)

    ' Write the Combinations / Permutations
    ' Since writing to the worksheet cell be cell is very slow, uses temporary arrays to write one column at a time
    Application.ScreenUpdating = False
    If lTotal <= Rows.Count Then
    Range("D1").Resize(lTotal, p).Value = vResultAll
    Else
    While iGroup * Rows.Count < lTotal
    lMax = lTotal - iGroup * Rows.Count
    If lMax > Rows.Count Then lMax = Rows.Count
    ReDim vResultPart(1 To lMax, 1 To p)
    For l = 1 To lMax
    For k = 1 To p
    vResultPart(l, k) = vResultAll(l + iGroup * Rows.Count, k)
    Next k
    Next
    Range("D1").Offset(0, iGroup * (p + 1)).Resize(lMax, p).Value = vResultPart
    iGroup = iGroup + 1
    Wend
    End If
    Application.ScreenUpdating = True
    End Sub

    Sub CombPermNP(ByVal vElements As Variant, ByVal p As Integer, ByVal bComb As Boolean, ByVal bRepet As Boolean, _
    ByVal vResult As Variant, ByRef lRow As Long, ByRef vResultAll As Variant, ByVal iElement As Integer, ByVal iIndex As Integer)
    Dim i As Integer, j As Integer, bSkip As Boolean

    For i = IIf(bComb, iElement, 1) To UBound(vElements)
    bSkip = False
    ' in case of permutation without repetition makes sure the element is not yet used
    If (Not bComb) And Not bRepet Then
    For j = 1 To p
    If vElements(i) = vResult(j) And Not IsEmpty(vResult(j)) Then
    bSkip = True
    Exit For
    End If
    Next
    End If

    If Not bSkip Then
    vResult(iIndex) = vElements(i)
    If iIndex = p Then
    lRow = lRow + 1
    For j = 1 To p
    vResultAll(lRow, j) = vResult(j)
    Next j
    Else
    Call CombPermNP(vElements, p, bComb, bRepet, vResult, lRow, vResultAll, i + IIf(bComb And bRepet, 0, 1), iIndex + 1)
    End If
    End If
    Next i
    End Sub

  5. #5
    Board Regular
    Join Date
    Mar 2019
    Posts
    204
    Post Thanks / Like
    Mentioned
    2 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Combination And Permutation with no repeat

    Hi Worf,

    As per your provided url, find the following error.

    Run time error 13
    Type mismath

    using the following file

    col 1 Col 2
    p 10
    Combinations FALSE
    Repetition TRUE
    SET 0
    1
    2
    3
    4
    5
    6
    7
    8
    9


    using the following code

    Option Explicit




    ' PGC Set 2007
    ' Calculates and writes the Combinations / Permutations with/without repetition
    ' Assumes the result is written from row 1 down. If the total number of cells in a column
    ' is less than tha number of results continues in another group of columns to the right.
    ' vElements - Array with the set elements (1 to n)
    ' p - number of elements in 1 combination/permutation
    ' bComb - True: Combinations, False: Permutations
    ' bRepet - True: with repetition, False: without repetition
    ' vResult - Array to hold 1 permutation/combination (1 to p)
    ' lRow - row number. the next combination/permutation is written in lRow+1
    ' vResultAll - Array to hold all the permutations/combinations (1 to Total, 1 to p)
    ' iElement - order of the element to process in case of combination
    ' iIndex - position of the next element in the combination/permutation


    ' Sub CombPerm() deals with the input / output
    ' Sub CombPermNP() generates the combinations / permutations


    Sub CombPerm()
    Dim rRng As Range, p As Integer
    Dim vElements As Variant, vResult As Variant, vResultAll As Variant, lTotal As Long
    Dim lRow As Long, bComb As Boolean, bRepet As Boolean
    Dim vResultPart, iGroup As Integer, l As Long, lMax As Long, k As Long


    ' Get the inputs and clear the result range (you may adjust for other locations)
    Set rRng = Range("B5", Range("B5").End(xlDown)) ' The set of numbers
    p = Range("B1").Value ' How many are picked
    bComb = Range("B2")
    bRepet = Range("B3")
    Range("D1", Cells(1, Columns.Count)).EntireColumn.Clear


    ' Error
    If (Not bRepet) And (rRng.Count < p) Then
    MsgBox "With no repetition the number of elements of the set must be bigger or equal to p"
    Exit Sub
    End If


    ' Set up the arrays for the set elements and the result
    vElements = Application.Index(Application.Transpose(rRng), 1, 0)
    With Application.WorksheetFunction
    If bComb = True Then
    lTotal = .Combin(rRng.Count + IIf(bRepet, p - 1, 0), p)
    Else
    If bRepet = False Then lTotal = .Permut(rRng.Count, p) Else lTotal = rRng.Count ^ p
    End If
    End With
    ReDim vResult(1 To p)
    ReDim vResultAll(1 To lTotal, 1 To p)


    ' Calculate the Combinations / Permutations
    Call CombPermNP(vElements, p, bComb, bRepet, vResult, lRow, vResultAll, 1, 1)


    ' Write the Combinations / Permutations
    ' Since writing to the worksheet cell be cell is very slow, uses temporary arrays to write one column at a time
    Application.ScreenUpdating = False
    If lTotal <= Rows.Count Then
    Range("D1").Resize(lTotal, p).Value = vResultAll
    Else
    While iGroup * Rows.Count < lTotal
    lMax = lTotal - iGroup * Rows.Count
    If lMax > Rows.Count Then lMax = Rows.Count
    ReDim vResultPart(1 To lMax, 1 To p)
    For l = 1 To lMax
    For k = 1 To p
    vResultPart(l, k) = vResultAll(l + iGroup * Rows.Count, k)
    Next k
    Next
    Range("D1").Offset(0, iGroup * (p + 1)).Resize(lMax, p).Value = vResultPart
    iGroup = iGroup + 1
    Wend
    End If
    Application.ScreenUpdating = True
    End Sub


    Sub CombPermNP(ByVal vElements As Variant, ByVal p As Integer, ByVal bComb As Boolean, ByVal bRepet As Boolean, _
    ByVal vResult As Variant, ByRef lRow As Long, ByRef vResultAll As Variant, ByVal iElement As Integer, ByVal iIndex As Integer)
    Dim i As Integer, j As Integer, bSkip As Boolean


    For i = IIf(bComb, iElement, 1) To UBound(vElements)
    bSkip = False
    ' in case of permutation without repetition makes sure the element is not yet used
    If (Not bComb) And Not bRepet Then
    For j = 1 To p
    If vElements(i) = vResult(j) And Not IsEmpty(vResult(j)) Then
    bSkip = True
    Exit For
    End If
    Next
    End If


    If Not bSkip Then
    vResult(iIndex) = vElements(i)
    If iIndex = p Then
    lRow = lRow + 1
    For j = 1 To p
    vResultAll(lRow, j) = vResult(j)
    Next j
    Else
    Call CombPermNP(vElements, p, bComb, bRepet, vResult, lRow, vResultAll, i + IIf(bComb And bRepet, 0, 1), iIndex + 1)
    End If
    End If
    Next i
    End Sub



    Help pls

  6. #6
    Board Regular
    Join Date
    Mar 2019
    Posts
    204
    Post Thanks / Like
    Mentioned
    2 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Combination And Permutation with no repeat

    Hi Worf ji,

    its working

    Thanks bro.....

  7. #7
    MrExcel MVP mikerickson's Avatar
    Join Date
    Jan 2007
    Location
    Davis CA
    Posts
    22,603
    Post Thanks / Like
    Mentioned
    20 Post(s)
    Tagged
    15 Thread(s)

    Default Re: Combination And Permutation with no repeat

    For the combinations, you might use this
    Code:
    Sub test()
        Dim Alphabet As Variant, Combination() As Boolean
        Dim OutArray() As Variant
        Dim EndOfCombos As Boolean
        Dim Size  As Long, i As Long, j As Long
        
        Size = 5: Rem adjust
        With Range("A:A")
            Alphabet = Application.Transpose(Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp)).Value)
        End With
        
        ReDim Combination(1 To UBound(Alphabet))
        For i = 1 To Size
            Combination(i) = True
        Next i
        ReDim OutArray(1 To Size)
        Range("c1").Resize(1, Size).EntireColumn.ClearContents
        
        Do
            j = 0
            For i = 1 To UBound(Combination)
                If Combination(i) Then
                    j = j + 1
                    OutArray(j) = Alphabet(i)
                End If
            Next i
            Range("C65536").End(xlUp).Offset(1, 0).Resize(1, Size).Value = OutArray
            Combination = NextCombo(Combination, EndOfCombos)
        Loop Until EndOfCombos
    End Sub
    
    Function NextCombo(ByVal currentCombo As Variant, Optional ByRef Overflow As Boolean) As Variant
        Dim LookAt As Long, WriteTo As Long
        
        LookAt = LBound(currentCombo)
        WriteTo = LookAt - 1
        Overflow = False
        
        Do Until currentCombo(LookAt)
            LookAt = LookAt + 1
        Loop
        
        Do
            WriteTo = WriteTo + 1
            currentCombo(LookAt) = False
            currentCombo(WriteTo) = True
            LookAt = LookAt + 1
            If UBound(currentCombo) < LookAt Then Exit Do
        Loop While currentCombo(LookAt)
        
        If UBound(currentCombo) < LookAt Then
            Overflow = True
        Else
            currentCombo(WriteTo) = False
            currentCombo(LookAt) = True
        End If
            
        NextCombo = currentCombo
    End Function
    I don't understand the permutaion question.
    Could you give a (small) example

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •