Alright, I have text1 and list1.... now, I want list1 to display all the permutations of the characters in text1, like if text1 had abcd then list1 would show a ab ac ad abc abd abcd... etc...
Haikus are easy.
But sometimes they don't make sense.
Refrigerator.
hmm well the only way I could think of is use a mid statement to insert a specific character between each character. Then use split to come up with every possible combination. Let me try to whip up an example function.
If a post has been helpful please rate it.
If your question has been answered, pull down the tread tools and mark it as resolved.
Since the number of possible combinations might exceed the limit of the ListBox control, you may want to use something different like a ListView. And optionally lock the window until it has finished loading them to make it faster, ex:
vb Code:
Option Explicit
Private Declare Function LockWindowUpdate Lib "user32" Alias "LockWindowUpdate" (ByVal hwndLock As Long) As Long
Here is my function for generating permutations of a string. Paste this code in a standard module (*.bas).
Code:
Option Explicit
Public Function Permutations(Letters As String, Optional IncludePartial As Boolean = False) As Collection
Dim colPermutations As Collection
Dim bytLetters() As Byte
Dim lngCharCount(255) As Long
Dim i As Long
Set colPermutations = New Collection
bytLetters = StrConv(Letters, vbFromUnicode)
For i = 0 To UBound(bytLetters)
lngCharCount(bytLetters(i)) = lngCharCount(bytLetters(i)) + 1
Next i
Call PermutationRecur(0&, bytLetters, lngCharCount, colPermutations, IncludePartial)
Set Permutations = colPermutations
Set colPermutations = Nothing
End Function
Private Sub PermutationRecur(ByVal Pos As Long, bytLetters() As Byte, lngCharCount() As Long, colPermutations As Collection, IncludePartial As Boolean)
Dim i As Long
For i = 0 To 255
If lngCharCount(i) > 0 Then
lngCharCount(i) = lngCharCount(i) - 1
bytLetters(Pos) = i
If Pos = UBound(bytLetters) Then
colPermutations.Add StrConv(bytLetters, vbUnicode)
Else
If IncludePartial Then
colPermutations.Add Left(StrConv(bytLetters, vbUnicode), Pos + 1)
End If
Call PermutationRecur(Pos + 1, bytLetters, lngCharCount, colPermutations, IncludePartial)
End If
lngCharCount(i) = lngCharCount(i) + 1
End If
Next i
End Sub
Paste this code in a form with Command1, Text1, and List1.
Code:
Option Explicit
Private Sub Command1_Click()
Dim colPerms As Collection
Dim i As Long
Set colPerms = Permutations(Text1.Text, True)
List1.Clear
For i = 1 To colPerms.Count
List1.AddItem colPerms(i)
Next i
MsgBox CStr(colPerms.Count) & " permutations"
Set colPerms = Nothing
End Sub
Run the program, type something in the textbox (keep it short...), then click the command button. Presto! Permutations in the listbox!
Now then, I should tell you that this isn't a very good way to find anagrams. Counting all partial permutations, you'll get over 100,000 from a string of 8 different letters. At best, about 500 of these (~0.5%) will be valid words.
Private Function GetPermutation(Y As String, Optional X As String = vbNullString) As Long
Dim idx As Long, pos As Long
Static cnt As Long
If Len(X) = 0 Then cnt = 0
pos = Len(Y)
If pos < 2 Then
mColPermutations.Add X & Y
cnt = cnt + 1
Else
For idx = 1 To pos
GetPermutation Left$(Y, idx - 1) & Right$(Y, pos - idx), X & Mid$(Y, idx, 1)
Next
End If
GetPermutation = cnt
End Function
Example usage
Code:
Private mColPermutations As Collection
Private Sub Command1_Click()
Dim lPerCount As Long, lPermStr As String
Dim i As Long
lPermStr = "SomeStr"
Set mColPermutations = New Collection
lPerCount = GetPermutation(lPermStr) '(Recursive Function)
'Show them..
List1.Clear
List1.AddItem "Permutations found: " & lPerCount
For i = 1 To mColPermutations.Count
List1.AddItem mColPermutations(i)
Next
Set mColPermutations = Nothing
End Sub
[RESOLVED] Permutations
Reply With Quote
