1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37
| Function AléatUnique(maTable, monChamp As String, De, a As Long) As Variant
Dim liste() As Variant
ReDim liste(a) ' j'ai préfèré crée au dim sup et non de De->a
requete = "SELECT " + monChamp + " AS idx FROM " + maTable + " WHERE " + monChamp + ">=" + Str(De) + " AND " + monChamp + "<=" + Str(a) + ";"
Set maRq = CurrentDb.OpenRecordset(requete)
debut = De
fin = a
If maRq.EOF Then GoTo suite 'il n'y a pas encore d'enregistrement
maRq.MoveFirst
While (Not maRq.EOF)
liste(maRq.idx) = maRq.idx
maRq.MoveNext
Wend
If maRq.RecordCount = (a - De + 1) Then Exit Function 'il n'y a plus de numéro dispo
maRq.Close
Do
While (Not IsEmpty(liste(debut))) And (debut <= fin): debut = debut + 1: Wend 'première place vide trouvé
While (IsEmpty(liste(fin))) And (debut <= fin): fin = fin - 1: Wend 'dernière valeur prise
If debut < fin Then
liste(debut) = liste(fin)
liste(fin) = debut 'permutation des places occupés avec ceux libre
fin = fin - 1
debut = debut + 1
End If
Loop Until debut >= fin
If debut = fin Then debut = debut + 1 'cas chevauchement
suite:
nalea = Int((a - debut + 1) * Rnd) + debut 'prend une valeur aléatoire sur la plage restante
If Not IsEmpty(liste(nalea)) Then nalea = liste(nalea) 'la valeur à déjà été prise donc on prend celle libre
AléatUnique = nalea
End Function |