re,
je n'ai aucune idée, 2 essais en rouge et si cela ne marche pas, est-ce que vous pouvez ajouter votre dernier fichier entier ici ?
(Il s'arrête maintenant sur la ligne rouge avec x= ... ou la ligne suivante ? Ici, tout passe bien
Sub Optimisé(nr)
Dim arr(), i As Double
a = Sheets("feuil1").ListObjects("Tableau1").DataBodyRange.Value 'les données
On Error Resume Next
arr = WorksheetFunction.RandArray(UBound(a)) 'array avec valeurs aleatoires, seulement pour 2021-365
On Error GoTo 0
If Err.Number = 0 Then 'des versions qui ne connaissent pas randarray
ReDim arr(1 To UBound(a), 1 To 1)
For i = 1 To UBound(arr): arr(i, 1) = [Rnd]: Next 'pour des versions moins récents
End If
Set dict = CreateObject("scripting.dictionary") 'cahier de brouillon
For i = 1 To Application.Min(UBound(a), nr)
x = WorksheetFunction.Small(arr, i)
r = Application.Match(WorksheetFunction.Small(arr, i), arr, 0) 'unique random integer
dict.Add dict.Count, Application.Index(a, r, 0) 'ajouter ligne correspondante au dictionary
Next
If dict.Count = 1 Then dict.Add dict.Count, Application.Index(a, r, 0) 'probeme avec dictionary avec un seul record
Res = Application.Index(dict.items, 0, 0)
End Sub