Discussion :

[joponta]

Bonjour,

Je cherche une macro qui pourrait réaliser ceci :

Compter les heures de chaque date dates distinctes d'une autre colonne.

J'ai en colonne B les dates et en colonne H le temps.

Colonne B	COLONNE H
01/01/2021 08:00	1:00
01/01/2021 08:00	1:00
01/01/2021 08:00	1:00
01/01/2021 09:00	2:00
01/01/2021 09:00	2:00
01/01/2021 09:00	2:00

Je voudrais faire la somme de chaque date unique, soit 3 : 00

J'ai essayer en vain avec cette macro :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Option Explicit
 
Dim dico As Object, f As Worksheet, i&
 
Sub ValeursUniques()
 
    Set dico = CreateObject("Scripting.Dictionary")
    Set f = Sheets("Feuil2")
 
    For i = 2 To f.Range("B" & Rows.Count).End(xlUp).Row
        dico(f.Range("B" & i).Value) = dico(f.Range("B" & i).Value) + Val(f.Range("H" & i))
        f.Range("AF1").Value = f.Range("S2").Value
    Next i
 
    Range("AC1").Resize(dico.Count, 1) = Application.Transpose(dico.keys)
    Range("AD1").Resize(dico.Count, 1) = Application.Transpose(dico.items)
End Sub

Merci pour votre retour.

[E KERGRESSE]

Bonjour,

1 solution possible :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
 
Sub TestValeursUniques()
 
Dim DerniereLigne As Long
Dim AireDates As Range, AireHeures As Range
 
    With Sheets("Feuil2")
         DerniereLigne = .Cells(.Rows.Count, "B").End(xlUp).Row
         Set AireDates = .Range(.Cells(2, "B"), .Cells(DerniereLigne, "B"))
         Set AireHeures = .Range(.Cells(2, "H"), .Cells(DerniereLigne, "H"))
         Debug.Print "Nombre d'heures : " & ValeursUniques(AireDates, AireHeures)
    End With
 
    Set AireDates = Nothing:  Set AireHeures = Nothing
 
End Sub
 
Function ValeursUniques(ByVal AireDates2 As Range, ByVal AireHeures2 As Range) As Double
 
Dim I As Integer
Dim DicoHeures As Object
Dim TotalValeur As Double
 
    Set DicoHeures = CreateObject("Scripting.Dictionary")
    ValeursUniques = 0
 
    For I = 1 To AireDates2.Count
        If IsDate(AireDates2(I)) Then
           If Not DicoHeures.Exists(CStr(AireDates2(I))) Then
              DicoHeures.Add CStr(AireDates2(I)), CStr(AireHeures2(I))
              TotalValeur = TotalValeur + AireHeures2(I)
           End If
        End If
    Next I
 
    ValeursUniques = TotalValeur * 24
 
    Set DicoHeures = Nothing
 
End Function

[joponta]

Merci pour votre aide, cela fonctionne très bien.
J'ai encore deux petites questions.

En colonne H, j'ai parfois des heures différentes parmi la même date. est-ce possible de retenir que la durée maxi.
Ainsi dans l'exemple ci-dessous, sur la date du 01/01/2021 8:00, je souhaiterais retenir le 1:00.

Colonne B	COLONNE H
01/01/2021 08:00	0:45
01/01/2021 08:00	1:00
01/01/2021 08:00	1:00
01/01/2021 09:00	2:00
01/01/2021 09:00	2:00
01/01/2021 09:00	2:00

Enfin en colonne U, j'ai le numéro du mois, est-ce possible de faire un regroupement par mois.

Merci à vous.

[E KERGRESSE]

Bonjour,

Il suffirait de trier la table par la colonne H du plus grand au plus petit.

Sinon, à quoi correspondrait ce regroupement par mois ?

[joponta]

Merci pour ce retour rapide.

Il s'agirait de compter la même chose par mois.
Dans l'exemple ci-dessous, je souhaiterais obtenir 3 heures pour janvier(mois 1), 4 heures pour février (mois2)...

Colonne B	COLONNE H	COLONNE U
01/01/2021 08:00	1:00	1
01/01/2021 08:00	1:00	1
01/01/2021 08:00	1:00	1
01/01/2021 09:00	2:00	1
01/01/2021 09:00	2:00	1
01/01/2021 09:00	2:00	1
01/02/2021 10:00	1:00	2
01/02/2021 10:00	1:00	2
01/02/2021 10:00	1:00	2
03/02/2021 09:00	3:00	2
03/02/2021 09:00	3:00	2

Merci à vous.

[E KERGRESSE]

Bonjour,

Une solution est possible en instanciant deux variables dico (DicoMois et DicouJours) pour remplir deux matrices sans doublons pour les mois et les jours dans le programme principal et en utilisant cette fonction modifiée. Cette nouvelle version de la fonction récupère la valeur max du groupe date-heure.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
 
Function ValeursUniques(ByVal AireDates2 As Range, ByVal AireHeures2 As Range, ByVal DateEnCours2 As Date) As Double
 
Dim J As Integer
Dim DicoHeures As Object
Dim TotalValeur As Double
 
    Set DicoHeures = CreateObject("Scripting.Dictionary")
    ValeursUniques = 0
 
    For J = 1 To AireDates2.Count
        If CDate(AireDates2(J)) = DateEnCours2 Then
           If Not DicoHeures.Exists(CStr(AireDates2(J))) Then
              DicoHeures.Add CStr(AireDates2(J)), CStr(AireHeures2(J))
              TotalValeur = AireHeures2(J)
           Else
              If AireHeures2(J) > TotalValeur Then TotalValeur = AireHeures2(J)
           End If
        End If
    Next J
 
    ValeursUniques = TotalValeur * 24
 
    Set DicoHeures = Nothing
 
End Function

[joponta]

Bonjour,

Merci pour pour la récupération de la valeur max.
Par contre je ne sais pas comment mettre en place les deux dicos.

Merci à vous

[Pierre Fauconnier]

Salut.

Finalement, tu veux retenir la somme ou le max, car ce n'est pas très clair?

Autre question, pourquoi le faire en VBA?

autre question: Pourquoi utiliser un dico (qui n'est pas du VBA) alors que même en VBA, Excel est équipé pour réaliser l'opération?

Il ne sert à rien de réinventer la roue, qui plus est avec un dico, alors que l'essence même d'Excel est de réaliser ce genre de traitement...

[Pierre Fauconnier]

Outre le fait qu'un TCD fait cela sans aucune formule, avec la somme ou avec le max...


Histoire de montrer au moinsseur la stupidité d'un dico, voire deux!!, pour réaliser cela, comme c'est stupide de réinventer des trucs dans Excel. Apprenez à utiliser l'outil avant de vouloir le réinventer.

[E KERGRESSE]

Envoyez-moi votre adresse mail en message privé, je vous enverrai ma solution.

[Pierre Fauconnier]

Envoyez-moi votre adresse mail en message privé, je vous enverrai ma solution.

Ce n'est pas DU TOUT l'esprit du forum...

Je ne peux que déconseiller au demandeur initial de procéder ainsi puisque ça va le priver d'autres réponses peut-être plus pertinentes et de la réactivité d'autres membres en le rendant dépendant d'un seul.

Une réponse sur le forum profite à tout le monde et peut être améliorée ou critiquée, ce qui est en soi une bonne chose et profite à nouveau à tous.

[Pierre Fauconnier]

Avec ton exemple, je viens de mieux comprendre le besoin. idéalement, les données devraient se trouver dans un tableau structuré (voir mon tuto => https://fauconnier.developpez.com/tu...ux-structures/)


1. Perso, puisqu'il s'agit apparemment de sommer les données sans doublons, je supprimerais les doublons en début de traitement. Ca permettrait à un TCD de faire le job.

2. On peut également réaliser tout le job avec Power Query (dédoublonnement et regroupement).

3. Avec une colonne supplémentaire, on peut utiliser un TCD directement


1. on dédoublonne puis on monte le TCD




2. Power Query

1. Insérer le tableau dans la solution power Query;
2. Dédoublonner sur les dates;
3. Ajouter une colonne avec le mois;
4. Regrouper sur le mois et sommer les heures;
5. Transformer la colonne des heures
6. Renvoyer dans Excel.

Code PowerQuery :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
let
    Source = Excel.CurrentWorkbook(){[Name="Tableau1"]}[Content],
    AdapterTypes = Table.TransformColumnTypes(Source,{{"Colonne B", type datetime}, {"COLONNE H", type number}, {"COLONNE U", Int64.Type}}),
    SupprimerDoublon = Table.Distinct(AdapterTypes, {"Colonne B"}),
    AjouterMois = Table.AddColumn(SupprimerDoublon, "Mois", each Date.MonthName([Colonne B])),
    GrouperSurMois = Table.Group(AjouterMois, {"Mois"}, {{"Total", each List.Sum([COLONNE H]), type nullable number}}),
    AdapterHeures = Table.TransformColumnTypes(GrouperSurMois,{{"Total", type time}})
in
    AdapterHeures

3. Ajout d'une colonne supplémentaire puis TCD

Attention, avec Excel 2013, la formule en C2 doit être validée en matricielle (CTRL+SHIFT+ENTER), ce qui ajoute les accolades de part et d'autre de la formule (il ne faut pas les ajouter soi-même lors de la saisie)





Question: Existe-t-il un réel besoin de réaliser cela par VBA?