Option Explicit
Private HDernUti As Date, TN°() As Long, GrnPréc As Double
Public Function Hasard(ByVal Rang As Long, ByVal Donné, Optional ByVal Graine As Double) As Variant
Rem. ——— Renvoie dans une cellule une information choisie aléatoirement d'une plage.
' Arguments :
' Rang: Rang dans la permutation du numéro souhaité.
' Donné: Deux possibilités :
' 1) — Une expression du numéro le plus élevé, la fonction en renvoyant un de 1 à Donné.
' 2) — Une plage d'une colonne contenant les valeurs possibles, la fonction renvoyant l'une d'elles.
' Graine: Base de départ de la série. Si omis l'ordre des numéros sera différent à chaque évaluation.
' Principe important: Cette fonction étant conçue pour une validation normale, non matricielle,
' elle construit un tableau sur lequel elle se base, ensuite, à chaque invocation,
' tant qu'il est récent de moins d'une seconde depuis sa dernière utilisation.
Dim RngDon As Range, LMax As Long, L As Long, P As Long
If TypeOf Donné Is Range Then
Set RngDon = Donné: LMax = RngDon.Rows.Count
ElseIf IsNumeric(Donné) Then
LMax = Donné
Else: Hasard = CVErr(xlErrValue): Exit Function: End If
On Error Resume Next: L = UBound(TN°): On Error GoTo 0
If Now - HDernUti > 1 / 86400 Or LMax <> L Or Graine <> GrnPréc Then
Rem. Ajout :
LMax = RngDon(1, 1).End(xlDown).Row - RngDon.Row + 1
'
ReDim TN°(1 To LMax): TN°(1) = 1
If Graine <= 0 Then Randomize Else Rnd -1: Randomize Graine
For L = 2 To LMax: P = Int(Rnd * L) + 1: If P < L Then TN°(L) = TN°(P)
TN°(P) = L: Next L
GrnPréc = Graine: End If
On Error Resume Next: L = TN°(Rang) ': On Error GoTo 0
If Err Then
Hasard = IIf(RngDon Is Nothing, 0, "")
ElseIf RngDon Is Nothing Then: Hasard = L
Else: Hasard = RngDon(L, 1).Value: End If
HDernUti = Now
End Function
