Recherche max et min selon date

Bonjour à tous,

Depuis quelque jours je suis bloqué sur macro qui me permettrait de récupérer l'horaire max et l'horaire min selon la date et calculé l'amplitude (Max - Min) (voir structure du tableaux en PJ)

J'ai réussi a avoir un résultat pour la première date puisque j'ai défini les ranges précisément. Seulement, je souhaite que cette macro fasse ce calcul pour toute les dates de mon tableaux, tout en sachant que le nombre de ligne accordé par date est variable.

j'ai pensé a faire une boucle, mais je ne vois pas comment l'exprimer...

sub Bouton1_Cliquer ()

Worksheets("feuil1").Activate

Set isectdebut = Application.Intersect(Range("A2:B9"), Range("B:B"))
Set isectfin = Application.Intersect(Range("A2:C9"), Range("C:C"))
If isectdebut Is Nothing Then

 MsgBox "les zones n'ont pas d'intersection"
Else
Cells(2, 4) = Application.WorksheetFunction.max(isectfin) - Application.WorksheetFunction.Min(isectdebut)

End If

End Sub

Merci de votre aide

bonne journée

Bonjour,

Une des solutions pourrait être le lire les cellules de la colonne A et lorsque la valeur passe de 0 à une valeur supérieur de 0, tu as déterminé ta plage.

ValeurDébut = "A1"

ValeurFin=""

For i = A2 to Ax (où x est la dernière ligne de ton tableau)

si et(ValeurDebut<>i; i > 0) then

ValeurFin = i-1

CalculDeAmplitude

ValeurDébut=i

end if

next i

Merci pour ta rapidité !

J'ai compris l'idée mais je comprend pas tout à fait ta conditionnelle et comment l'intégrer

Je laisse les experts VBA t'aider pour le code !

Bonjour Glad00, jpbt84,

jpbt84 a écrit :

Je laisse les experts VBA t'aider pour le code !

Je ne suis expert en rien (même pas en ping-pong ), mais il me semble que tu peux essayer ce qui suit:

Sub Bouton1_Cliquer()

For lig = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    deb = Cells(lig + 1, 2)
    fin = Cells(lig, 3).Offset(Cells(lig, 1).MergeArea.Count - 2, 0)
    Cells(lig, 4) = fin - deb
    lig = lig + Cells(lig, 1).MergeArea.Count - 1
Next lig

End Sub

Attention: je me suis basé sur la structure du fichier transmis, avec les cellules fusionnées en colonne A et les lignes vides avant et après chaque "groupe d'heures"

Merci de ton aide !

Ton code fonctionne effectivement ! mais comme tu le précise il fonctionne pour la structure jointe, et le boulet que je suis à oublier de préciser que le nombre de cellule vide avant et après les heures peuvent varier. désolée!

j'avais essayer aussi la fonction dmax mais sans succes ..

Glad00 a écrit :

le nombre de cellule vide avant et après les heures peuvent varier

Sub Bouton1_Cliquer()

For lig = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    deb = Cells(lig, 2).End(xlDown)
    fin = Cells(lig, 3).Offset(Cells(lig, 1).MergeArea.Count - 1, 0).End(xlUp)
    Cells(lig, 4) = fin - deb
    lig = lig + Cells(lig, 1).MergeArea.Count - 1
Next lig

End Sub

Merci U.milité, cette version fonctionne !!

j'ai également trouvé une solution :

Sub Bouton1_Cliquer()

Worksheets("feuil1").Activate

For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row

Set isectdebut = Application.Intersect(Range(Cells(i, 1), Cells(i + Application.Range("A" & i).MergeArea.Rows.Count, 2)), Range("B:B"))
Set isectfin = Application.Intersect(Range(Cells(i, 1), Cells(i + Application.Range("A" & i).MergeArea.Rows.Count, 3)), Range("C:C"))

If isectdebut Is Nothing Then

 MsgBox "les zones n'ont pas d'intersection"
Else
Cells(i, 4) = Application.WorksheetFunction.Max(isectfin) - Application.WorksheetFunction.Min(isectdebut)
End If
Next i

End Sub

Problème résolu merci de votre implication ! bonne soirée