Récupérer aléatoirement une valeur unique d'un tableau

Soyez le premier à donner votre avis sur cette source.

Snippet vu 27 355 fois - Téléchargée 9 fois


Commenter

Contenu du snippet 

Private Function GetSingleValue(ByRef aArr() As String, sResult As String) As Boolean
    On Error GoTo Err_Handler
        
    Dim lb As Integer
    lb = LBound(aArr)
    
'   on récupère un index
    Dim Index As Long
    Index = Int((UBound(aArr) * Rnd) + (LBound(aArr)))
    
'   on récupère la  valeur
    sResult = aArr(Index)
    
'    on  écrase la position par la dernière valeur et on supprime la  dernière  position
    aArr(Index) = aArr(UBound(aArr))
    
    If (Index = lb) And (lb = UBound(aArr)) Then
        Erase aArr
    Else
        ReDim Preserve aArr(lb To UBound(aArr) - 1)
    End If
    GetSingleValue = True
    Exit Function
    
Err_Handler:
'tableau  vide
End Function


'    EXEMPLE  D'UTILISATION (nécessite un bouton et une textbox)
Option Explicit
Dim aMyArray() As String 'attention, la premier index (0 ici) ne sera pas utilisé
'
'
Private Sub Form_Load()
'   applique le facteur "aléatoire"
    Randomize Timer
    
'   redimension et remplissage du tableau
    Dim i As Long
    ReDim aMyArray(0 To 10)
    For i = LBound(aMyArray) + 1 To UBound(aMyArray)
        aMyArray(i) = "chaîne [" & CStr(i) & "]"
    Next i
'   pour le test....
    Text1.Width = 2895
    Text1.Text = vbNullString
End Sub
'
'
Private Sub Command1_Click()
    Dim sRet As String
    If GetSingleValue(aMyArray, sRet) Then
        Text1.Text = sRet
    Else
        Text1.Text = "Toutes les valeurs ont été piochées"
    End If
End Sub

Compatibilité : VB6, VBA

Disponible dans d'autres langages :

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (PCPT)