Recherche 4 val liste écart min

Bonjour à tous,

Avez-vous des conseils à me donner pour résoudre cette demande ? Merci d'avance

Comment identifier les 4 valeurs d'une liste numérique sous Excel (colonne non ordonnée avec de nombreuse valeur) ayant l'écart le plus faible? Si possible sans utilisation de fonction matricielle (VBA Ok) ?

Meilleures salutations

Boxermen

bonjour,

Sub test()
     With Range("A1").CurrentRegion.Columns(1) '1000 valeurs aleatoirs
          .Offset(, 1).Value = .Value     'copie des valeurs vers colonne B
          a = .Offset(, 1).Value     '>>> matrice de cette colonne B
     End With

     Delta = 1E+99
     For i = 0 To UBound(a) - 4 'boucle
          rijen = Evaluate("=row(" & Range("A1:A4").Offset(i).Address & ")") 'créer une séquence de 4 numéro succesives et chaque fois incrementer avec 1
          a4 = Application.Transpose(Application.Index(a, rijen, 1)) '4 chiffres de la colonne B
          mymin = Application.Min(a4)
          mymax = Application.Max(a4)
          d = mymax - mymin
          If d < Delta Then
               Delta = d
               solution = a4
               rij = i
          End If
     Next
     Range("E1").Resize(, 4).Value = solution
     Range("E2").Value = Delta
     Range("E3").Value = Range("B1").Resize(4).Offset(rij).Address(0, 0)

End Sub

Bonjour et bienvenue sur le forum

Bonjour à tous

Une variante

Bye !

Bonjour à tous,

Personnellement, je n'ai rien compris.

Un fichier exemple, avec des résultats manuels serait, pour moi, le bienvenu !

Crdlmt

Nouvelle variante (trop chaud pour aller dehors !)

Bye !

apparament on l'a compris d'une manière différente !

@BsAjv :

En effet !

Attendons la réponse de Boxermen mais je crains fort de devoir me joindre à DjiDji en disant que je n'ai rien compris !

Bye !

Bonjour à tous,

Merci pour votre soutien mais les solutions proposées (bien que très élégantes) ne correspondent pas à mon besoin. Je viens de joindre un fichier permettant de mieux comprendre ma demande. Merci infiniment d'avance.

bonjour,

il suffit d'ajouter un tri à la proposition de BsALv

Sub test()
     With Range("A1").CurrentRegion.Columns(1) '1000 valeurs aleatoirs
          .Offset(, 1).Value = .Value     'copie des valeurs vers colonne B
          .Offset(, 1).Sort key1:=.Offset(, 1), key1:=xlAscending, Header:=xlNo
          a = .Offset(, 1).Value     '>>> matrice de cette colonne B
     End With

     Delta = 1E+99
     For i = 0 To UBound(a) - 4 'boucle
          rijen = Evaluate("=row(" & Range("A1:A4").Offset(i).Address & ")") 'créer une séquence de 4 numéro succesives et chaque fois incrementer avec 1
          a4 = Application.Transpose(Application.Index(a, rijen, 1)) '4 chiffres de la colonne B
          mymin = Application.Min(a4)
          mymax = Application.Max(a4)
          d = mymax - mymin
          If d < Delta Then
               Delta = d
               solution = a4
               rij = i
          End If
     Next
     Range("E1").Resize(, 4).Value = solution
     Range("E2").Value = Delta
     Range("E3").Value = Range("B1").Resize(4).Offset(rij).Address(0, 0)

End Sub

Parfait !!!

Merci beaucoup

Bonjour à tous,

Pour le plaisir, une proposition 365 (à tester !) (formule unique et dynamique) :

=LET(
p_;A7:B13;
d_;DECALER(p_;;1;;1);
m_;MIN(d_);
e_;d_-m_;
FILTRE(p_;(e_<=PETITE.VALEUR(e_;5))*(d_<>m_))
)

comme on est (presque) tout 365, une macro pour nous avec les données de JFL

Edit : j'ai corrigé un erreur

Sub Prüfung()
     With Sheets("tabelle1")
          With .Range("A6").CurrentRegion
               a = Application.Sort(.Offset(1).Resize(.Rows.Count - 1, 2), 2)     'matrice avec les données sorté par la 2ième colonne
          End With

          mymin = 1E+99
          myrow = 0
          For i = 1 To UBound(a) - 3     'boucle pour trouver le min entre un élément et l'élement 3 en dessous de la 2ième colonne
               Delta = a(i + 3, 2) - a(i, 2)
               If Delta < mymin Then
                    mymin = Delta
                    myrow = i
               End If
          Next

          If myrow > 0 Then     'trouvé !
               .Range("M8").Resize(4, 2).Value = Application.Index(a, WorksheetFunction.Sequence(4, 1, myrow), WorksheetFunction.Sequence(1, 2))     'le résultat
               .Range("P8").Resize(4, 2).Value = Application.Sort(Application.Index(a, WorksheetFunction.Sequence(4, 1, myrow), WorksheetFunction.Sequence(1, 2)), 1)     'le résultat dans la sequence original
          Else
               MsgBox "sorry"
          End If

     End With
End Sub