PDA

View Full Version : [vba] array con ordinamento casuale


john_revelator
13-06-2009, 15:09
Buon pomeriggio. Ho la necessità di rendere casuale l'ordinamento di un array.

Ho trovato a questo indirizzo

http://www.cpearson.com/excel/ShuffleArray.aspx

la seguente funzione:


Public Function ShuffleArray(InArray() As Variant) As Variant()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ShuffleArray
' This function returns the values of InArray in random order. The original
' InArray is not modified.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim N As Long
Dim L As Long
Dim Temp As Variant
Dim J As Long
Dim Arr() As Variant


Randomize
L = UBound(InArray) - LBound(InArray) + 1
ReDim Arr(LBound(InArray) To UBound(InArray))
For N = LBound(InArray) To UBound(InArray)
Arr(N) = InArray(N)
Next N
For N = LBound(InArray) To UBound(InArray)
J = Int((UBound(InArray) - LBound(InArray) + 1) * Rnd + LBound(InArray))
If N <> J Then
Temp = Arr(N)
Arr(N) = Arr(J)
Arr(J) = Temp
End If
Next N
ShuffleArray = Arr
End Function


ma quando cerco di applicarla al mio array


Sub mischia()
Dim ordinato, casuale As Variant
Dim i As Integer
ordinato = Array("a", "b", "c")
'MsgBox TypeName(ordinato)
casuale = ShuffleArray(ordinato)
For i = LBound(casuale) To UBound(casuale)
MsgBox casuale(i)
Next i
End Sub


in corrispondenza di questa riga

casuale = ShuffleArray(ordinato)

continuo a ricevere l'errore di "Tipo non corrispondente. Prevista matrice o tipo definito dall'utente." Dove sbaglio? Ciao e grazie per l'attenzione.

john_revelator
14-06-2009, 11:26
Risolto così


Function ArrayShuffle(arr As Variant)
Dim index As Long
Dim newIndex As Long
Dim firstIndex As Long
Dim itemCount As Long
Dim tmpValue As Variant

firstIndex = LBound(arr)
itemCount = UBound(arr) - LBound(arr) + 1

For index = UBound(arr) To LBound(arr) + 1 Step -1
newIndex = firstIndex + Int(Rnd * itemCount)
tmpValue = arr(index)
arr(index) = arr(newIndex)
arr(newIndex) = tmpValue
itemCount = itemCount - 1
Next
ArrayShuffle = arr
End Function