XL 2010 Module de classe avec Dictionary

[cathodique]

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

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 Function

Dans module de classe

Option Explicit

Public Societe As String
Public HeurTrav As Double
Public LaDate As Date

En vous remerciant par avance.

 

[laurent950]

Bonsoir @cathodique

tu ne stock rien dans le module de classe
Tu souhaites faire quoi ?

 

[cathodique]

Bonsoir @laurent950 ,

tu ne stock rien dans le module de classe

Si J'ai bien compris dans le module de classe, on déclare juste les variables.
Ensuite, le code du tuto du net rempli le tableau de destination. Dans ce tuto, il cumule des heures de travail pour différentes entreprises, et récupère la date la plus récente.

J'ai voulu modifier ce code pour faire 2 choses:
Au lieu de sommer les heures pour chaque entreprises, je voudrais compter le nombre de fois qu'on rencontre les entreprises via ce concept de module de classe.
Et dans un second temps, faire un remove clé (entreprise) qui serait apparue plus d'une fois.
En espérant, que tu aies compris mon problème.

Merci beaucoup

Nb: ma demande à 2 objectifs: Résoudre 1 problème et apprendre un peu plus dur les dictionnaires et m'initier au module de classe pour le dictionnaire.

 

[laurent950]

Si J'ai bien compris dans le module de classe, on déclare juste les variables.

Oui

Ensuite, le code du tuto du net rempli le tableau de destination

Oui mais avec les informations du module de classe qui est encapsuler dans la variable dictionnaire

Dans ce tuto, il cumule des heures de travail pour différentes entreprises

Oui, c'est actualisé dans le module de classe

et récupère la date la plus récente

Oui c'est toujours actualisé dans le module de classe

J'ai voulu modifier ce code pour faire 2 choses:

Au lieu de sommer les heures pour chaque entreprises, je voudrais compter le nombre de fois qu'on rencontre les entreprises via ce concept de module de classe.

A Partir du stockage dans le module de classe il n'y a plus de limite
J'ai adapter votre code dont je ne comprend pas la finalité

Et dans un second temps, faire un remove clé (entreprise) qui serait apparue plus d'une fois.

Effectivement une fois la classe actualisé, (la photocopie du module de classe inclus dans cette variable dictionnaire doit etre détruite pour en reconstruire une nouvelle photocopie de cette classe actualisé
c'est fait dans le code ci joint

Nb: ma demande à 2 objectifs: Résoudre 1 problème et apprendre un peu plus dur les dictionnaires et m'initier au module de classe pour le dictionnaire.

Le module de classe est indépendant du dictionnaire, mais pour stocké plusieurs module de classe c'est alors que l'on utilise le dictionnaire


le code ci dessous (j'ai pas trop dénaturé pour pas que vous soyer perdu) mais pour comprendre les changement (l'utilisation du module de classe)

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

 

[laurent950]

Au lieu de sommer les heures pour chaque entreprises, je voudrais compter le nombre de fois qu'on rencontre les entreprises via ce concept de module de classe.

Je vous montre

 

[cathodique]

Oui


Oui mais avec les informations du module de classe qui est encapsuler dans la variable dictionnaire

Oui, c'est actualisé dans le module de classe

Oui c'est toujours actualisé dans le module de classe


A Partir du stockage dans le module de classe il n'y a plus de limite
J'ai adapter votre code dont je ne comprend pas la finalité

Effectivement une fois la classe actualisé, (la photocopie du module de classe inclus dans cette variable dictionnaire doit etre détruite pour en reconstruire une nouvelle photocopie de cette classe actualisé
c'est fait dans le code ci joint


Le module de classe est indépendant du dictionnaire, mais pour stocké plusieurs module de classe c'est alors que l'on utilise le dictionnaire


le code ci dessous (j'ai pas trop dénaturé pour pas que vous soyer perdu) mais pour comprendre les changement (l'utilisation du module de classe)

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

Merci beaucoup.
C'est un bon début pour moi. Les modules de classes sont un vrai mystère pour moi.
Je manipule un peu les dictionnaires, mais j'avoue que très souvent je m'y perds.

Avec toute ma gratitude. Je regarderai tout ça demain à tête reposée.

Bonne soirée.

 

[cathodique]

Je vous montre

Oui avec plaisir. Merci beaucoup.

 

[Dranreb]

Bonsoir
Un code applicatif très court serait possible en utilisant ma fonction Gigogne.
Si ça vous intéresse, bien sûr. En plus les noms de sociétés se retrouveraient automatiquement classés par ordre alpha.

 

[cathodique]

Je n'ai pas pu attendre jusqu'à demain.

@laurent950 : ton code renvoie des résultats faux. merci quand d'avoir essayé de m'aider.

Les bons résultats pour le cumul ci-dessous

Bonne soirée.

 

[laurent950]

je regarde

 

[cathodique]

Bonsoir
Un code applicatif très court serait possible en utilisant ma fonction Gigogne.
Si ça vous intéresse, bien sûr. En plus les noms de sociétés se retrouveraient automatiquement classés par ordre alpha.

Bonsoir @Dranreb ,

Je te remercie. Veux-tu m'aider à comprendre ce que je demande.
Module de classe pour dictionnaire.
Je veux comprendre et apprendre. je ne cherche pas du tout cuit.
Tu t'es cassé la tête pour atteindre un bon niveau. C'est aussi mon objectif.
Bien que je sois qu'un développeur du dimanche.

Bonne soirée.

 

[cathodique]

Voila c'est fait ajouter une quatrième colonne avec tableau structuré

Pourquoi ajouter une 4ème colonne?

 

[laurent950]

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

Pourquoi ajouter une 4ème colonne?

je voudrais compter le nombre de fois qu'on rencontre les entreprises via ce concept de module de classe.

Au lieu de sommer les heures pour chaque entreprises, je voudrais compter le nombre de fois qu'on rencontre les entreprises via ce concept de module de classe.

le module de classe : ClsHtravail

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

 

[dysorthographie]

bonsoir,
de ce que j'ai compris

'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

 

[Dranreb]

J'en conclue que ça ne vous intéresse pas.
Je reproduis quand même le code :

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