Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel Compter une durée total par site + mois + durée en VBA

Compter une durée total par site + mois + durée en VBA

18 réponses
Avatar
Apitos
Bonsoir =E0 tous,

Afin de calculer une dur=E9e totale par trois conditions :=20

- Nom du site=20

- Mois choisi en H2 depuis une liste de validation

- Cause choisi en I2 depuis une liste de validation

J'ai utilis=E9 le code joint dans l'exemple suivant :

http://cjoint.com/?BIhrxjOxc2c

J'ai r=E9ussi =E0 extraire les noms des sites respectant le mois choisi, et=
mettre la d=E9f=E9rence de temps dans la colonne G pour les dur=E9es s'=E9=
tendant sur des dates de deux mois d=E9f=E9rents.

Le reste j=92attends votre aide pour le r=E9aliser.

Merci d'avance.
Signaler un problème avec ce contenu

8 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2
Avatar
Apitos
Bonjour Daniel,

Le traitement ce fait normalement pour les dates qui s'étalent entre Juil let-Août et Août-Août, mais ne marche pas pour celles qui s'étalent entre Août-Septembre.

Par exemple, les cas suivants, ne sont pas traiter par le code :

MSF 29/08/2012 22:21 02/09/2012 09:48 03 jour 11h:27mn CS
TID 31/08/2012 17:20 02/09/2012 08:54 01 jour 15h:34mn CS
SDA 31/08/2012 17:05 03/09/2012 17:26 03 jour 00h:21mn CS
SHA 30/08/2012 17:06 01/09/2012 17:26 02 jour 00h:20mn CS

Merci.
Avatar
Apitos
Bonjour Daniel,

J'ai essayé de modifier ton dernier code pour avoir le format des cellule s en : jours/heures/minutes, mais je n'ai pas réussi :

"--------------------
Sub test()
Dim Dico As Object, C As Range, Mois As Integer, Plage As Range, Plage1 As Range, Ligne As Integer
Dim Item As Variant, Ligne1 As Integer
Application.ScreenUpdating = False
Ligne = 1
Set Dico = CreateObject("Scripting.Dictionary")
With Feuil1
'--------
Columns("K:M").Clear
'---------
Mois = Application.Match(.[G2], Feuil3.[A:A], 0)
For Each C In .Range(.[A2], .Cells(.Rows.Count, 1).End(xlUp))
If (C.Offset(, 1) < DateSerial(2012, Mois, 1) And C.Offset(, 2) < DateSerial(2012, Mois, 1)) Or _
(C.Offset(, 1) > DateSerial(2012, Mois + 1, 1) And C.Offset( , 2) > DateSerial(2012, Mois + 1, 1)) Then
.Cells(C.Row, 14) = 0
.Cells(C.Row, 15) = 0
Else
.Cells(C.Row, 14) = Application.Max(DateSerial(2012, Mois , 1), C.Offset(, 1))
.Cells(C.Row, 15) = Application.Min(DateSerial(2012, Mois + 1, 1), C.Offset(, 2))
End If
If Not Dico.Exists(C.Value) Then
Dico.Add C.Value, C.Value
End If
Next C
Set Plage = .Range(.[A1], Cells(.Rows.Count, 1).End(xlUp)).Resize (, 15)

For Each Item In Dico.Items
.AutoFilterMode = False
Set Plage1 = Plage
Plage1.AutoFilter 1, Item
Plage1.AutoFilter 5, .[I2]
Plage1.AutoFilter 14, ">=" & Format(DateSerial(2012, Mois, 1) , "mm/dd/yyyy")
Plage1.AutoFilter 15, "<=" & Format(DateSerial(2012, Mois + 1 , 1), "mm/dd/yyyy")
If Application.Subtotal(103, .[A:A]) > 1 Then
Ligne = Ligne + 1
.Cells(Ligne, 11) = Item
.Cells(Ligne, 12) = Application.Subtotal(109, .[O:O]) - A pplication.Subtotal(109, .[N:N])
End If
Next Item

'---------------
.Columns("L:L").Insert Shift:=xlToRight
.Cells(1, "K") = "Site"
.Cells(1, "L") = "Durée total de l'arrêt"
.Cells(1, "M") = "Durée (Min)"
.Cells(2, "L").Formula = _
"=TEXT(M2/1440,""jj"""" jours"""" hh"""" heures"""" mm"""" minut es"""""")"

Ligne = .Cells(.Rows.Count, "A").End(xlUp).Row
.Cells(2, "L").AutoFill Range("L2:L" & Ligne)
.Cells(2, "L").EntireColumn.AutoFit
.Cells(2, "K").Resize(Ligne, 3).Sort Key1:=.Cells(2, "K"), Order1 :=xlAscending, Header:=xlNo
'---------------
.AutoFilterMode = False
.[O:P].ClearContents
End With
Application.ScreenUpdating = False
End Sub
"--------------------
Avatar
DanielCo
Bonjour,
Après :
With Sheets("Feuil1")
mets :
.[L:L].NumberFormat = "dd ""jour"" hh""h"":mm""mn"""
Daniel


Bonjour Daniel,

J'ai essayé de modifier ton dernier code pour avoir le format des cellules en :
jours/heures/minutes, mais je n'ai pas réussi :
Avatar
Apitos
Bonsoir Daniel,

Je l'ai ajouté sans rien de changer.

Un exemple :

http://cjoint.com/?BImp4ZT6IsX
Avatar
DanielCo
Ce qui me désole, c'est que tu n'as l'air de rien comprendre au code
VBA. Quel est exactement ton niveau de connaissance ?
Exécute la macro :
Sub testformat()
.[L:L].NumberFormat = "dd ""jour"" hh""h"":mm""mn"""
End Sub
et regarde le format de la colonne L.
Daniel

Bonsoir Daniel,

Je l'ai ajouté sans rien de changer.

Un exemple :

http://cjoint.com/?BImp4ZT6IsX
Avatar
Apitos
Bonjour Daniel,

Peut-être quelque chose m'échappe, mais dans l'exemple joint, il y a bi en un problème ? Non ?

'----------
Sub test()
Dim Dico As Object, C As Range, Mois As Integer, Plage As Range, Plage1 As Range, Ligne As Integer
Dim Item As Variant, Ligne1 As Integer
Application.ScreenUpdating = False
Ligne = 1
Set Dico = CreateObject("Scripting.Dictionary")
With Feuil1
'--------
Columns("K:M").Clear
'---------
.[L:L].NumberFormat = "dd ""jour"" hh""h"":mm""mn"""
Mois = Application.Match(.[G2], Feuil3.[A:A], 0)
For Each C In .Range(.[A2], .Cells(.Rows.Count, 1).End(xlUp))
If (C.Offset(, 1) < DateSerial(2012, Mois, 1) And C.Offset(, 2) < DateSerial(2012, Mois, 1)) Or _
(C.Offset(, 1) > DateSerial(2012, Mois + 1, 1) And C.Offset( , 2) > DateSerial(2012, Mois + 1, 1)) Then
.Cells(C.Row, 14) = 0
.Cells(C.Row, 15) = 0
Else
.Cells(C.Row, 14) = Application.Max(DateSerial(2012, Mois , 1), C.Offset(, 1))
.Cells(C.Row, 15) = Application.Min(DateSerial(2012, Mois + 1, 1), C.Offset(, 2))
End If
If Not Dico.Exists(C.Value) Then
Dico.Add C.Value, C.Value
End If
Next C
Set Plage = .Range(.[A1], Cells(.Rows.Count, 1).End(xlUp)).Resize (, 15)

For Each Item In Dico.Items
.AutoFilterMode = False
Set Plage1 = Plage
Plage1.AutoFilter 1, Item
Plage1.AutoFilter 5, .[I2]
Plage1.AutoFilter 14, ">=" & Format(DateSerial(2012, Mois, 1) , "mm/dd/yyyy")
Plage1.AutoFilter 15, "<=" & Format(DateSerial(2012, Mois + 1 , 1), "mm/dd/yyyy")
If Application.Subtotal(103, .[A:A]) > 1 Then
Ligne = Ligne + 1
.Cells(Ligne, 11) = Item
.Cells(Ligne, 12) = Application.Subtotal(109, .[O:O]) - A pplication.Subtotal(109, .[N:N])
End If
Next Item

'---------------
.Columns("L:L").Insert Shift:=xlToRight
.Cells(1, "K") = "Site"
.Cells(1, "L") = "Durée total de l'arrêt"
.Cells(1, "M") = "Durée (Min)"
.Cells(2, "L").Formula = _
"=TEXT(M2/1440,""jj"""" jours"""" hh"""" heures"""" mm"""" minute s"""""")"

Ligne = .Cells(.Rows.Count, "A").End(xlUp).Row
.Cells(2, "L").AutoFill Range("L2:L" & Ligne)
.Cells(2, "L").EntireColumn.AutoFit
.Cells(2, "K").Resize(Ligne, 3).Sort Key1:=.Cells(2, "K"), Order1 :=xlAscending, Header:=xlNo
'---------------
.AutoFilterMode = False
.[O:P].ClearContents
End With
Application.ScreenUpdating = False
End Sub
'----------
Avatar
DanielCo
Où ?
Est-ce que le petit exemple que je t'ai donné ne fait pas l'affaire ?
Pourquoi tu me ressort ce code, puisque tu as adopté une autre solution
? Pourquoi est-ce que tu poses les mêmes questions sur plusieurs forums
? Quant à moi, j'arrête la discussion sur ce forum.
Daniel


Bonjour Daniel,

Peut-être quelque chose m'échappe, mais dans l'exemple joint, il y a bien un
problème ? Non ?

'----------
Sub test()
Dim Dico As Object, C As Range, Mois As Integer, Plage As Range, Plage1
As Range, Ligne As Integer Dim Item As Variant, Ligne1 As Integer
Application.ScreenUpdating = False
Ligne = 1
Set Dico = CreateObject("Scripting.Dictionary")
With Feuil1
'--------
Columns("K:M").Clear
'---------
.[L:L].NumberFormat = "dd ""jour"" hh""h"":mm""mn"""
Mois = Application.Match(.[G2], Feuil3.[A:A], 0)
For Each C In .Range(.[A2], .Cells(.Rows.Count, 1).End(xlUp))
If (C.Offset(, 1) < DateSerial(2012, Mois, 1) And C.Offset(, 2) <
DateSerial(2012, Mois, 1)) Or _ (C.Offset(, 1) >
DateSerial(2012, Mois + 1, 1) And C.Offset(, 2) > DateSerial(2012, Mois + 1,
1)) Then .Cells(C.Row, 14) = 0 .Cells(C.Row,
15) = 0 Else
.Cells(C.Row, 14) = Application.Max(DateSerial(2012, Mois,
1), C.Offset(, 1)) .Cells(C.Row, 15) =
Application.Min(DateSerial(2012, Mois + 1, 1), C.Offset(, 2)) End
If If Not Dico.Exists(C.Value) Then
Dico.Add C.Value, C.Value
End If
Next C
Set Plage = .Range(.[A1], Cells(.Rows.Count, 1).End(xlUp)).Resize(,
15)

For Each Item In Dico.Items
.AutoFilterMode = False
Set Plage1 = Plage
Plage1.AutoFilter 1, Item
Plage1.AutoFilter 5, .[I2]
Plage1.AutoFilter 14, ">=" & Format(DateSerial(2012, Mois, 1),
"mm/dd/yyyy") Plage1.AutoFilter 15, "<=" &
Format(DateSerial(2012, Mois + 1, 1), "mm/dd/yyyy") If
Application.Subtotal(103, .[A:A]) > 1 Then Ligne = Ligne + 1
.Cells(Ligne, 11) = Item
.Cells(Ligne, 12) = Application.Subtotal(109, .[O:O]) -
Application.Subtotal(109, .[N:N]) End If
Next Item

'---------------
.Columns("L:L").Insert Shift:=xlToRight
.Cells(1, "K") = "Site"
.Cells(1, "L") = "Durée total de l'arrêt"
.Cells(1, "M") = "Durée (Min)"
.Cells(2, "L").Formula = _
"=TEXT(M2/1440,""jj"""" jours"""" hh"""" heures"""" mm""""
minutes"""""")"

Ligne = .Cells(.Rows.Count, "A").End(xlUp).Row
.Cells(2, "L").AutoFill Range("L2:L" & Ligne)
.Cells(2, "L").EntireColumn.AutoFit
.Cells(2, "K").Resize(Ligne, 3).Sort Key1:=.Cells(2, "K"),
Order1:=xlAscending, Header:=xlNo '---------------
.AutoFilterMode = False
.[O:P].ClearContents
End With
Application.ScreenUpdating = False
End Sub
'----------
Avatar
Apitos
Bonsoir Daniel,

Toutes mes excuses pour la peine que tu as donnée pour me venir en aide.

Merci pour tout l'effort fourni dans tes réponses.
1 2