Ecart le plus petit entre 4 cellules

[Chri8Ed]

Bonjour

Je souhaiterais trouver le plus écart entre 4 cellules

(Ces 4 cellules sont placées côte à côte sur une même ligne et font références à des dates)

Exemple :
G4(01/08/2010), H4(18/08/2010), I4(30/08/2010), J4(14/09/2010)

Je souhaiterais trouver en K4 l'écart en jour le plus petit entre n'importe laquelle de ces dates.

En l'occurrence dans le cas présent le chiffre "12".

Existe t-il une fonction pour me permette de trouver cette valeur ?

Merci d'avance

Bonne journée

 

[Chri8Ed]

Re : Ecart le plus petit entre 4 cellules

Bonsoir ROGER2327

Merci pour ta participation

J'ai bien recopié ta macro, telle quelle ou en changeant la zone

Mais je vois pas de changement

Peut-tu m'expliquer un peu plus ou te servir de mon fichier exemple ?

Merci

 

[ROGER2327]

Re : Ecart le plus petit entre 4 cellules

Re...

N'utilisant pas Excel2007, je ne peux intervenir sur votre classeur.
Je joins un classeur au format .xls. Dans chacune des trois feuilles, je donne un exemple différent d'implantation de la procédure. En regardant le code de chaque feuille, vous devriez comprendre les modifications.
J'ai légèrement modifié la procédure pour tenir compte d'éventuelles saisies de données incorrectes, mais le code est essentiellement inchangé.
Pour la feuille Feuil3, par exemple, on a :

[COLOR="DarkSlateGray"][B]Private Sub Worksheet_Change(ByVal Target As Range)
Dim oPlg, oCel As Range
Dim vDat&(), v%, ErrMsg$
Dim delta&, i&, j&
   With Range("[COLOR="Red"]C6,D9,E6,F9[/COLOR]") [COLOR="Red"]'***[/COLOR]
      Set oPlg = Intersect(Target, .Cells)
      If Not oPlg Is Nothing Then
         On Error GoTo E
         For Each oCel In Range("[COLOR="Red"]C9:F9[/COLOR]").Cells [COLOR="Red"]'***[/COLOR]
            If Not IsEmpty(oCel) And oCel.Value <> "" Then
               v = v + 1
               ReDim Preserve vDat(1 To v)
               vDat(v) = CLng(Int(CDbl(oCel.Value) + 1 / 6))
            End If
         Next oCel
         delta = 2147483647
         For i = 1 To v - 1
            For j = i + 1 To v
               delta = WorksheetFunction.Min(delta, Abs(vDat(j) - vDat(i)))
            Next j
         Next i
F:       On Error GoTo 0
         Application.EnableEvents = False
         [[COLOR="Red"]H9[/COLOR]].Value = IIf(v > 1, delta, ErrMsg) [COLOR="Red"]'***[/COLOR]
         Application.EnableEvents = True
      End If
   End With
Exit Sub
E: ErrMsg = "Erreur"
   v = 0
   Resume F
End Sub[/B][/COLOR]

Les lignes marquées '*** sont celles qui peuvent différer d'une feuille à l'autre.

Les feuilles sont protégées sans mot de passe : vous pouvez facilement enlever la protection en cas de besoin.​

ROGER2327
#4134

Dimanche 8 Absolu 138 (Absinthe, ci devant Saint Alfred, ST)
29 Fructidor An CCXVIII
2010-W37-3T22:49:19Z

 

[Chri8Ed]

Re : Ecart le plus petit entre 4 cellules

C’est parfait !

Côté macro ; je ne suis pas très expérimenté
J’arrive à comprendre cependant le principe
Mais là, cela dépasse mes connaissances (pour l’instant ….)

En attendant, le résultat est parfait

J’ai fait pas mal d’essais, cela correspond exactement à mes exigences

J’avais opté pour la modification des dates à l’entrée, pour plus de simplicité.
Mais comme j’ai beaucoup de dates qui sont déjà entrées
Je vais aussi utiliser ta macro.

J’ai retenue le principe de la 1ère feuille, car mon tableau est déjà pas mal large
Ou il faudrait une nouvelle macro qui cache ou ouvre la zone…

Juste une petite remarque sur la 2ème feuille.
Il y a donc une zone de calcul en plus,
Je m’attendais donc à voir en vert la date entrée ex : « 18/09/2010 21 :00 »
Et en rouge la date convertie soit pour cet exemple « 19/09/2010 »
Ce qui apporterait un plus…

Merci beaucoup à tous les deux.

 

[ROGER2327]

Re : Ecart le plus petit entre 4 cellules

Re...

Dans la feuille Feuil2, on a la formule :

[COLOR="DarkSlateGray"][B]=SI(C6="";"";C6)[/B][/COLOR]

en G4. Elle recopie sans changement la valeur contenue en C6.

Si vous voulez qu'elle pratique l'arrondi comme vous l'avez défini, il suffit de la modifier ainsi :

[COLOR="DarkSlateGray"][B]=SI(C6="";"";ENT(C6+1/6))[/B][/COLOR]

ROGER2327
#4142

Mardi 10 Absolu 138 (Dilution, V)
1er Sanculottide An CCXVIII
2010-W37-5T23:00:13Z

 

[Chri8Ed]

Re : Ecart le plus petit entre 4 cellules

Bonjour

Là, j'aurais du y penser !

En fait, je n'avais pas été voir, car je pensais que ces cellules étaient gérées directement par la macro, comme celle du résultat "K3"

Merci encore

Bonne journée

 

[ROGER2327]

Re : Ecart le plus petit entre 4 cellules

Re...

(...) je pensais que ces cellules étaient gérées directement par la macro (...)

C'était une possibilité (et c'eut été plus simple...), mais je ne l'ai pas fait volontairement pour permettre d'utiliser des formules en cas de besoin.
Car, bien sûr, écrire dans ces cellules par le biais de la procédure écraserait les formules qui pourraient s'y trouver.​

ROGER2327
#4145

Mercredi 11 Absolu 138 (Sainte Purée, sportswoman, SQ)
2ème Sanculottide An CCXVIII
2010-W37-6T07:13:51Z

 

[Chri8Ed]

Re : Ecart le plus petit entre 4 cellules

Effectivement, c'est bien vu.

J'ai remarqué par ailleurs que dans la cellule résultat, on pouvait la modifier ou l'effacer sans incidence, la macro, à la moindre frappe d'une date dans la zone concernée, la réactualise et réaffecte le résultat.

Bien !

 

[boulou]

Re : Ecart le plus petit entre 4 cellules

Bonjour à tous

Si on peut recourir à VisualBasic :

[COLOR="DarkSlateGray"][B]Private Sub Worksheet_Change(ByVal Target As Range)
Dim oPlg, oCel As Range
Dim vDat&(), v%
Dim delta&, i&, j&
   With Range("G4:J4") [COLOR="SeaGreen"]'À adapter en fonction des cellules _
                              susceptibles de modifier les données.[/COLOR]
      Set oPlg = Intersect(Target, .Cells)
      If Not oPlg Is Nothing Then
         For Each oCel In Range("G4:J4").Cells
            If Not IsEmpty(oCel) Then
               v = v + 1
               ReDim Preserve vDat(1 To v)
               vDat(v) = CLng(Int(CDbl(oCel.Value) + 1 / 6))
            End If
         Next oCel
         delta = 2147483647
         For i = 1 To v - 1
            For j = i + 1 To v
               delta = WorksheetFunction.Min(delta, Abs(vDat(j) - vDat(i)))
            Next j
         Next i
         Application.EnableEvents = False
         [K4].Value = IIf(v > 1, delta, "")
         Application.EnableEvents = True
      End If
   End With
End Sub[/B][/COLOR]

à placer dans le module de la feuille concernée.​

ROGER2327
#4128

Dimanche 8 Absolu 138 (Absinthe, ci devant Saint Alfred, ST)
29 Fructidor An CCXVIII
2010-W37-3T11:29:44Z

Ce ROGER est un Dieu vivant !!!