|
|||||||
|
|
|
![]() |
|
|
Strumenti |
|
|
#1 |
|
Senior Member
Iscritto dal: Jul 2007
Messaggi: 1092
|
[vba] array con ordinamento casuale
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: Codice:
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
Codice:
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
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. |
|
|
|
|
|
#2 |
|
Senior Member
Iscritto dal: Jul 2007
Messaggi: 1092
|
Risolto così
Codice:
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
|
|
|
|
|
| Strumenti | |
|
|
Tutti gli orari sono GMT +1. Ora sono le: 18:23.



















