cathodique
XLDnaute Barbatruc
Bonsoir,
Je n'ai jamais monté de module de classe tout seul. Et encore moins avec un dictionnaire.
J'ai suivi un tuto (en Allemand, je n'ai rien compris aux explications), je n'ai pas lâché le morceau m'aidant de Google pour la traduction des commentaires du code.
En gros, il utilise un module de classe pour cumuler des heures et récupérer plus de 2 données dans le dictionnaire.
Son code fonctionne parfaitement bien.
J'ai voulu modifier un peu son code pour, au lieu de faire le cumul, compter le nombre d’occurrences.
Et pour aller plus, supprimer toutes les clés qu'on rencontre plus d'une fois.
Pour ceux et celles qui n'ouvrent jamais les fichiers joints voici le code.
Dans module standard
Dans module de classe
En vous remerciant par avance.
Je n'ai jamais monté de module de classe tout seul. Et encore moins avec un dictionnaire.
J'ai suivi un tuto (en Allemand, je n'ai rien compris aux explications), je n'ai pas lâché le morceau m'aidant de Google pour la traduction des commentaires du code.
En gros, il utilise un module de classe pour cumuler des heures et récupérer plus de 2 données dans le dictionnaire.
Son code fonctionne parfaitement bien.
J'ai voulu modifier un peu son code pour, au lieu de faire le cumul, compter le nombre d’occurrences.
Et pour aller plus, supprimer toutes les clés qu'on rencontre plus d'une fois.
Pour ceux et celles qui n'ouvrent jamais les fichiers joints voici le code.
Dans module standard
VB:
Option Explicit
Sub ResultatDictionary()
Dim dic As Dictionary, key As Variant, lig As ListRow
Set dic = RemplirDictionary
With Feuil2.ListObjects("TbResultat")
'Vider le tableau
If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
'boucle sur toutes les clés du dictionnaire
For Each key In dic
'Ajouter une ligne au tableau
Set lig = .ListRows.Add
lig.Range(, 1) = dic(key).Societe
lig.Range(, 2) = dic(key).HeurTrav
lig.Range(, 3) = dic(key).LaDate
Next key
End With
End Sub
Function RemplirDictionary() As Dictionary
'on ajoute as dictionary
'Activer bibliothèque Microsoft Runtime Scripting
Dim dic As New Dictionary
Dim cel As Range
'on declare variable du module de classe
Dim HeureTravail As ClsHtravail
'parcourir toutes les cellules des entreprises
For Each cel In Range("TbSource[Société]")
'Vérifiez si l'entreprise existe dans le dictionnaire
If dic.Exists(cel.Value) = True Then
'compter les heures
dic(cel.Value).HeurTrav = dic(cel.Value).HeurTrav + cel.Offset(0, 1).Value
'Déterminez la date de fin
If dic(cel.Value).LaDate < cel.Offset(0, 2).Value Then dic(cel.Value).LaDate = cel.Offset(0, 2).Value
Else
'initialisation de la classe
Set HeureTravail = New ClsHtravail
'on rempli(alimente) la classe
HeureTravail.Societe = cel.Value
HeureTravail.HeurTrav = cel.Offset(0, 1).Value
HeureTravail.LaDate = cel.Offset(0, 2).Value
Set dic(cel.Value) = HeureTravail
End If
Next cel
'Définir la valeur de retour pour la fonction
Set RemplirDictionary = dic
End FunctionDans module de classe
Code:
Option Explicit
Public Societe As String
Public HeurTrav As Double
Public LaDate As DateEn vous remerciant par avance.