Perfeito, Mauro. Muito obrigado. Agora eu quero outro código que faça essa permutação com letras da seguinte forma:
Pode ser mais de uma letra agrupada, por exemplo:
abc, def, ghi, jkl
Então preciso que o código identifique através de vírgula os grupos de letras que serão permutados.
É muito parecido, só que em vez de a, deve considerar abc, em vez de b, deve considerar def, em vez de c, deve considerar ghi, em vez de d, deve considerar jkl.
Em vez de permutar: abcd, acdb etc.
Ficaria abcdefghijkl, abcghijkldef etc.
Mas nem sempre serão 3 letras agrupadas, por isso preciso que identifique através de vírgula.
Fiz algumas modificações no código, mas ainda não deu certo:
'Fonte
''https://www.extendoffice.com/documents/excel/3657-excel-generate-all-permutations.html
'Adaptação Mauro Coutinho
Option Explicit
Dim sQde As Long
Private Sub btn_Calcular_Click()
Call GetString
txtCombinations.Text = sQde
End Sub
Sub GetString()
'Updateby Extendoffice 20160606
Dim xStr As String
Dim FRow As Long
Dim xScreen As Boolean
Dim matriz As String
Dim qtd, ext As Integer
xScreen = Application.ScreenUpdating
Application.ScreenUpdating = False
xStr = txtNumeroItens.Text
If Len(xStr) < 2 Then
Exit Sub
' If Len(xStr) >= 8 Then
' MsgBox "Too many permutations!", vbInformation, "Kutools for Excel"
' Exit Sub
Else
lstResultados.Clear
FRow = 1
ext = InStr(1, xStr, ",") - 1
qtd = UBound(Split(xStr, ",")) + 1
Call GetPermutation("", xStr, FRow, qtd, ext)
End If
Application.ScreenUpdating = xScreen
End Sub
Sub GetPermutation(Str1 As String, Str2 As String, ByRef xRow As Long, ByVal xLen As Integer, ByVal ext As Integer)
Dim i As Integer
' xLen = Len(Str2)
If xLen < 2 Then
UserForm1.lstResultados.AddItem Str1 & Str2
xRow = xRow + 1
Else
For i = 1 To xLen
Call GetPermutation(Str1 + Mid(Str2, i, ext), Left(Str2, ext + i - 1) + Replace(Replace(Right(Str2, ext + xLen - i), ",", ""), " ", ""), xRow, xLen, ext)
Next
sQde = xRow - 1
sQde = sQde
End If
End Sub
Postado : 09/12/2017 9:45 am