XL 2010 Module de classe avec Dictionary

Option Explicit
Sub ResultatDictionary()
   Dim dic As Dictionary
   Dim key As Variant
   Dim lig As ListRow
  
  'on declare variable du module de classe
   Dim HeureTravail As ClsHtravail
  
   ' Remplir le dictionnaire (on transforme la procedure ci-dessous en fonction)
        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
              ' Récupére le module de classe
              Set HeureTravail = dic(key)
              lig.Range(, 1) = HeureTravail.Societe
              lig.Range(, 2) = HeureTravail.HeurTrav
              lig.Range(, 3) = HeureTravail.LaDate
           Next key
        End With
End Sub

'Sub RemplirDictionary()
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
         'on ajoute la variable de la classe à la ligne ci-dessous utilisée sans la classe
         'dic(cel.Value) = dic(cel.Value) + cel.Offset(0, 1).Value 'après introduit module de classe
         ' ----->>>>   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
        
         ' Récupére le module de classe
         Set HeureTravail = dic(cel.Value)
         ' Pour L'excercice
         HeureTravail.HeurTrav = HeureTravail.HeurTrav + dic(cel.Value).HeurTrav + cel.Offset(0, 1).Value
         If HeureTravail.LaDate < cel.Offset(0, 2).Value Then HeureTravail.LaDate = cel.Offset(0, 2).Value
         dic.Remove (cel.Value)
         dic.Add key:=cel.Value, Item:=HeureTravail
      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

         'on ajoute la clé et l'item dans le dictionnaire
         'dic(cel.Value) = cel.Offset(0, 1).Value
         'ligne ci-dessus mis en commentaire et remplacer par
         'la ligne ci-dessous où on utilise la classe
         dic.Add key:=cel.Value, Item:=HeureTravail
      End If
   Next cel
   'Définir la valeur de retour pour la fonction
   Set RemplirDictionary = dic
End Function
'End Sub

Option Explicit
Sub ResultatDictionary()
   Dim dic As Dictionary ' ................. Dictionnaire
   Dim key As Variant ' .................... Clef
   Dim HeureTravail As ClsHtravail ' ....... On declare variable du module de classe
   Dim lig As ListRow ' .................... Tableau Structuré
 
   ' Remplir le dictionnaire (on transforme la procedure ci-dessous en fonction)
        Set dic = RemplirDictionary(dic)

        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 ' Ajout d'une ligne au tableau structuré
              Set HeureTravail = dic(key) ' Récupére le module de classe
                lig.Range(, 1) = HeureTravail.Societe
                lig.Range(, 2) = HeureTravail.HeurTrav
                lig.Range(, 3) = HeureTravail.LaDate
                ' je voudrais compter le nombre de fois qu'on rencontre les entreprises via ce concept de module de classe.
                lig.Range(, 4) = HeureTravail.SocieteCompte
           Next key
        End With
End Sub

Function RemplirDictionary(ByVal dic As Dictionary) As Dictionary
'Activer bibliothèque Microsoft Runtime Scripting
   Dim cel As Range
   Dim HeureTravail As ClsHtravail 'on declare variable du module de classe
 
   Set dic = New Dictionary

   '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
         ' Récupére le module de classe
            Set HeureTravail = dic(cel.Value)
         ' Pour L'excercice
            HeureTravail.HeurTrav = HeureTravail.HeurTrav + cel.Offset(0, 1).Value 'compter les heures
            If HeureTravail.LaDate < cel.Offset(0, 2).Value Then HeureTravail.LaDate = cel.Offset(0, 2).Value 'Déterminez la date de fin
        ' je voudrais compter le nombre de fois qu'on rencontre les entreprises via ce concept de module de classe.
         HeureTravail.SocieteCompte = HeureTravail.SocieteCompte + 1
         dic.Remove (cel.Value)
         dic.Add key:=cel.Value, Item:=HeureTravail
      Else
         Set HeureTravail = New ClsHtravail 'initialisation de la classe
         'on rempli(alimente) la classe
         HeureTravail.Societe = cel.Value
         HeureTravail.HeurTrav = cel.Offset(0, 1).Value
         HeureTravail.LaDate = cel.Offset(0, 2).Value
         ' je voudrais compter le nombre de fois qu'on rencontre les entreprises via ce concept de module de classe.
         HeureTravail.SocieteCompte = 1
         dic.Add key:=cel.Value, Item:=HeureTravail
      End If
   Next cel
   'Définir la valeur de retour pour la fonction
   Set RemplirDictionary = dic
End Function
'End Sub

Option Explicit

' Déclaration des variables privées
Private pSociete As String
Private pHeurTrav As Double
Private pLaDate As Date
' je voudrais compter le nombre de fois qu'on rencontre les entreprises via ce concept de module de classe.
Private pSocieteCompte As Integer

' Propriétés pour accéder et modifier les variables privées
Public Property Get Societe() As String
    Societe = pSociete
End Property

Public Property Let Societe(ByVal Value As String)
    pSociete = Value
End Property

Public Property Get HeurTrav() As Double
    HeurTrav = pHeurTrav
End Property

Public Property Let HeurTrav(ByVal Value As Double)
    pHeurTrav = Value
End Property

Public Property Get LaDate() As Date
    LaDate = pLaDate
End Property

Public Property Let LaDate(ByVal Value As Date)
    pLaDate = Value
End Property

Public Property Get SocieteCompte() As Integer
    SocieteCompte = pSocieteCompte
End Property

Public Property Let SocieteCompte(ByVal Value As Integer)
    pSocieteCompte = Value
End Property

' Constructeur: Initialise la classe avec des valeurs par défaut ou spécifiques
Private Sub Class_Initialize()
    ' Initialisation par défaut, vous pouvez modifier selon vos besoins
End Sub

' Destructeur: Libère les ressources si nécessaire
Private Sub Class_Terminate()
    ' Nettoyage si nécessaire
    ' Aucune action spécifique nécessaire pour les types de données de base
End Sub

'Sub RemplirDictionary()
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 Not dic.Exists(cel.Value) Then Set dic(cel.Value) = New ClsHtravail
         With dic(cel.Value)
            ' Pour L'excercice
            .Societe = cel.Value
            .HeurTrav = .HeurTrav + cel.Offset(0, 1).Value
            If .LaDate < cel.Offset(0, 2).Value Then .LaDate = cel.Offset(0, 2).Value
        End With
   Next cel
   'Définir la valeur de retour pour la fonction
   Set RemplirDictionary = dic
End Function
'End Sub

Sub RésultatGigogne()
   Dim ClnDon As Collection, TRésu(), SGrSoc As SsGr, L As Long, TDét()
   Set ClnDon = Gigogne([TbSource], 1, Null, 3)
   ReDim TRésu(1 To ClnDon.Count, 1 To 4)
   For Each SGrSoc In ClnDon
      L = L + 1
      TRésu(L, 1) = SGrSoc.Id ' Le nom de la société
      TRésu(L, 2) = SGrSoc.Count ' Le nombnre d'occurrences
      TDét = SGrSoc.DonnéesDébut: TRésu(L, 3) = TDét(3) ' Date la plus ancienne
      TDét = SGrSoc.DonnéesFin: TRésu(L, 4) = TDét(3) ' Date la plus récente
      Next SGrSoc
   TableauRetaillé([TbResultat2].ListObject) = TRésu
   End Sub