Col JS è un'impresa....
Avrei trovato questa http://www.vbi.org/Items/article.asp?id=133 (con anche il grasso che cola) che ho convertito per lavorare con le stringhe....
codice:
Public Shared Sub Permutate(ByVal ArrayCount As Long, ByRef Elements() As String, ByRef Order() As String, ByRef Orders As Collection)
'ArrayCount is the number of elements in the original array to permutate,
'Elements() Is the array To permutate (remember, this will grow shorter As we work, so the ArrayCount parameter cannot be deduced from the length Of Elements).
'Order Is the temporary array where we store one permutation, And
'Orders Is the Collection where we store all permutations found.
Dim Position As Long
Dim Element As String
Dim i As Long
Dim ArrayLen As Long
' The length of the Elements array. We need this
' for our calculations later on.
ArrayLen = (UBound(Elements) - LBound(Elements) + 1)
' Position in the Order array of the first element in
' the permutated arrays.
'
' Example: Given the array(a,b,c,d), where we want to permutate
' (b,c,d), the position in the new array for the first element
' will be 2 (since (a) will take up the first position).
' Likewise, when we permutate (c,d), the position of the first
' element will be 3, since the first two spots are taken by
' (a,b).
Position = ArrayCount - ArrayLen + 1
If ArrayLen = 1 Then
' The most primitive array we will permutate.
' The result is the array itself, and the result
' is inserted in the last position of the Order array.
Order(Position) = Elements(LBound(Elements))
' This Order is now complete, since the final element has
' been filled in.
Orders.Add(Order)
Else
' The permutation of Elements is each distinct Element
' + all permutations of the remaining elements.
For i = LBound(Elements) To UBound(Elements)
Element = Elements(i)
Order(Position) = Element
Permutate(ArrayCount, RemoveFromArray(Elements, Element), Order, Orders)
Next i
End If
End Sub
Public Shared Function RemoveFromArray(ByRef Elements() As String, ByVal Element As String) As String()
Dim NewArray() As String
Dim i As Long
Dim newi As Long
' Will create a new array where Element has been left out.
'ReDim NewArray(LBound(Elements) To UBound(Elements) - 1)
ReDim NewArray(0 To UBound(Elements) - 1)
For i = LBound(Elements) To UBound(Elements)
If Elements(i) <> Element Then
newi = newi + 1
NewArray(newi) = Elements(i)
End If
Next
RemoveFromArray = NewArray
End Function
tranne che non riesco a farla funzionare perchè mi va in indice oltre i limiti dell'array... mi aiutate?