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

1. Combination And Permutation with no repeat

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.  Reply With Quote

2. Re: Combination And Permutation with no repeat  Reply With Quote

3. Re: Combination And Permutation with no repeat

Thanks bro  Reply With Quote

4. 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  Reply With Quote

5. 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  Reply With Quote

6. Re: Combination And Permutation with no repeat

Hi Worf ji,

its working

Thanks bro.....  Reply With Quote

7. 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  Reply With Quote

User Tag List

Tags for this Thread

combination, formula, permutation, provide, vba  Posting Permissions

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