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....
tranne che non riesco a farla funzionare perchè mi va in indice oltre i limiti dell'array... mi aiutate?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

Rispondi quotando