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.

 

[patricktoulon]

bonsoir cathodique
perso je ne vois pas l'utilité d'un dictionnaire ici
ton module classe doit avoir un nom par instance de classe et les 3 propriétés ou membre que tu desire compiler
alors bien sur un dictionnaire pourrait faciliter(on pourrait le croire) faciliter l’accès a une des société par son nom mais pourrait se faire par une fonction dans la classe
j'irais même jusqu'a dire qu'une simple variable type dependante d'une autre ferait l'affaire ici

 

[patricktoulon]

ou inversement un dico et pas de classe

 

[patricktoulon]

démonstration avec un simple dico
a la fin dans la boucle tu as tes 4 valeurs
a savoir [ nom , occurence , date la plus recente , cumul des heures ]
ces valeurs sont dans un array chaque array correspond à sa clé dans le dico
tout simplement
une boucle sur le dico et tu peux faire ce que tu veux avec les valeurs

Sub test()
    Dim Dico As Object, cel As Range, myarray, k
    Set Dico = CreateObject("scripting.dictionary")
    For Each cel In ThisWorkbook.Sheets("Source").Range("TbSource").Columns(1).Cells

        If Not Dico.Exists(cel.Text) Then
            Dico(cel.Text) = Array(cel.Text, 1, cel.Offset(, 2).Value, cel.Offset(, 1).Value)
        Else
            myarray = Dico(cel.Text)
            myarray(1) = myarray(1) + 1
            myarray(3) = myarray(3) + cel.Offset(, 1)
            If CDate(cel.Offset(, 2)) > CDate(myarray(2)) Then myarray(2) = CDate(cel.Offset(, 2).Value)
            Dico(cel.Text) = myarray
        End If
    Next

    'tes quatres valeurs pour chaque sociétés ,sont dans les items du dico (sous la forme d'un array)
    'a savoir  [ nom ,  occurence  , date la plus recente  ,  cumul des heures ]

    For Each k In Dico.Keys
        MsgBox Join(Dico(k), " | ")
    Next
End Sub

maintenant si tu veux vraiment débuter avec les classes et utiliser un dico pour accéder aux instance nominativement(c'est à ça et rien que ca que sert le dico) voici une démo simplicime

tout d'abords on va créer un module classe (je ne me casse pas la tête je vais l'appeler classe1)
voila le code la classe

Public Nom As String
Public Occur As Long
Public Lastdate As Date
Public Cumul As Double

non non je plaisante pas c'est vraiment tout ce qu'il te faut
maintenant l'exploitation dans un module
et là encore une fois dans la boucle sur le dico tu a tes 4 valeurs
sauf que cette fois ci dans les items du dico ce n'est plus un array qu'il y a mais des instance de classe une pour chaque nom de société

Dim Dic As Object
Dim cl As Classe1
Sub test()
    Dim cel As Range, myarray, k, cl
    Set Dic = CreateObject("scripting.dictionary")
    For Each cel In ThisWorkbook.Sheets("Source").Range("TbSource").Columns(1).Cells

        If Not Dic.Exists(cel.Text) Then
            Set cl = New Classe1
            cl.Nom = cel.Text
            cl.Occur = 1
            cl.Cumul = cel.Offset(, 1).Value
            cl.Lastdate = cel.Offset(, 3)
            Set Dic(cel.Text) = cl
        Else
            Set cl = Dic(cel.Text)
            cl.Occur = cl.Occur + 1
            cl.Cumul = cl.Cumul + cel.Offset(, 1).Value
            If cl.Lastdate < CDate(cel.Offset(, 2)) Then cl.Lastdate = cel.Offset(, 2)

        End If
    Next

    'tes quatres valeurs pour chaque sociétés ,sont dans les items du Dic (sous la forme d'un array)
    'a savoir  [ nom ,  occurence  , date la plus recente  ,  cumul des heures ]

    For Each k In Dic.Keys
       With Dic(k)
       MsgBox .Nom & "  ,  " & .Cumul & "  ,  " & .Lastdate
    'tu fait ce que tu veux avec les valeurs ici
End With
    Next
End Sub

 

[cathodique]

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

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

Bonjour @laurent950 ,

Je te remercie beaucoup pour tout. Je vais essayer de comprendre ce que tu m'as présenté.
Je n'y connais rien aux modules de classe. Je constate que c'est un gros morceau de vba.
Je ne voulais ajouter au tableau une colonne mais à la place des heures au lieu du cumul, y mettre le nombre d’occurrences.
Encore merci. Bonne journée

 

[cathodique]

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

Bonjour @dysorthographie ,

Je te remercie pour ta contribution. Ton code donne le même résultat que le code de mon post#1.
Au lieu de faire le cumul des heures, je voudrais dans la même colonne mais dans un autre tableau connaître de nombre de fois travailler dans chaque entreprise.

Merci beaucoup.
Bonne journée.

 

[cathodique]

démonstration avec un simple dico
a la fin dans la boucle tu as tes 4 valeurs
a savoir [ nom , occurence , date la plus recente , cumul des heures ]
ces valeurs sont dans un array chaque array correspond à sa clé dans le dico
tout simplement
une boucle sur le dico et tu peux faire ce que tu veux avec les valeurs

Sub test()
    Dim Dico As Object, cel As Range, myarray, k
    Set Dico = CreateObject("scripting.dictionary")
    For Each cel In ThisWorkbook.Sheets("Source").Range("TbSource").Columns(1).Cells

        If Not Dico.Exists(cel.Text) Then
            Dico(cel.Text) = Array(cel.Text, 1, cel.Offset(, 2).Value, cel.Offset(, 1).Value)
        Else
            myarray = Dico(cel.Text)
            myarray(1) = myarray(1) + 1
            myarray(3) = myarray(3) + cel.Offset(, 1)
            If CDate(cel.Offset(, 2)) > CDate(myarray(2)) Then myarray(2) = CDate(cel.Offset(, 2).Value)
            Dico(cel.Text) = myarray
        End If
    Next

    'tes quatres valeurs pour chaque sociétés ,sont dans les items du dico (sous la forme d'un array)
    'a savoir  [ nom ,  occurence  , date la plus recente  ,  cumul des heures ]

    For Each k In Dico.Keys
        MsgBox Join(Dico(k), " | ")
    Next
End Sub

maintenant si tu veux vraiment débuter avec les classes et utiliser un dico pour accéder aux instance nominativement(c'est à ça et rien que ca que sert le dico) voici une démo simplicime

tout d'abords on va créer un module classe (je ne me casse pas la tête je vais l'appeler classe1)
voila le code la classe

Public Nom As String
Public Occur As Long
Public Lastdate As Date
Public Cumul As Double

non non je plaisante pas c'est vraiment tout ce qu'il te faut
maintenant l'exploitation dans un module
et là encore une fois dans la boucle sur le dico tu a tes 4 valeurs
sauf que cette fois ci dans les items du dico ce n'est plus un array qu'il y a mais des instance de classe une pour chaque nom de société

Dim Dic As Object
Dim cl As Classe1
Sub test()
    Dim cel As Range, myarray, k, cl
    Set Dic = CreateObject("scripting.dictionary")
    For Each cel In ThisWorkbook.Sheets("Source").Range("TbSource").Columns(1).Cells

        If Not Dic.Exists(cel.Text) Then
            Set cl = New Classe1
            cl.Nom = cel.Text
            cl.Occur = 1
            cl.Cumul = cel.Offset(, 1).Value
            cl.Lastdate = cel.Offset(, 3)
            Set Dic(cel.Text) = cl
        Else
            Set cl = Dic(cel.Text)
            cl.Occur = cl.Occur + 1
            cl.Cumul = cl.Cumul + cel.Offset(, 1).Value
            If cl.Lastdate < CDate(cel.Offset(, 2)) Then cl.Lastdate = cel.Offset(, 2)

        End If
    Next

    'tes quatres valeurs pour chaque sociétés ,sont dans les items du Dic (sous la forme d'un array)
    'a savoir  [ nom ,  occurence  , date la plus recente  ,  cumul des heures ]

    For Each k In Dic.Keys
       With Dic(k)
       MsgBox .Nom & "  ,  " & .Cumul & "  ,  " & .Lastdate
    'tu fait ce que tu veux avec les valeurs ici
End With
    Next
End Sub

Bonjour @patricktoulon ,

Trés belle démonstration. Je te remercie.
Tu viens de m'apprendre 2 choses en même temps.
1- Comment utiliser un array avec un dictionnaire.
2- Module de classe.

Cette seconde notion est encore très floue dans esprit. Arriverai-je un jour à l'assimiler?!!!

Merci beaucoup pour ton partage.

Bonne journée.

 

[cathodique]

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

Bonjour @Dranreb ,

Je sais que tu es très fort. Je te l'ai dit à plusieurs reprises. Pour utiliser un code, je dois en comprendre un minimum. Mais surtout savoir, le réutiliser seul dans d'autres projets.
Je t'avais promis de faire un effort pour essayer de comprendre tes codes 'gigognes'.
J'ai essayé. J'ai maltraité ma touche F8. Mais je n'ai pas compris grand chose.
ça passe d'une fonction à une autre. Au final, ça fait le boulot mais moi je n'ai rien compris. Et, ça me frustre.
Je me dis soit que je suis nul, soit que tu es trop fort. Dans les 2 cas, je suis le dindon de la farce.

En tout cas bravo pour ton boulot.
Encore merci.
Bonne journée.

 

[cathodique]

perso je ne vois pas l'utilité d'un dictionnaire ici

Rebonjour,

En fait ma présente discussion est pour mieux comprendre l'utilisation d'un module de classe pour récupérer plusieurs données avec un dico (suite à un tuto en vidéo sur youtube).
Tu m'as montré comment le faire avec un array et un module de classe.

à la recherche d'une solution à mon problème (double objectif solution + apprentissage), j'ai pensé au module de classe peut-être à tort.
Je dois repéré des numéros (en doublons, triplons, ... etc) qui n'ont pas de doublon et d'autres données rattachées à chaque numéro.
Mon raisonnement était assez simple, via un dictionnaire compter le nombre d'occurrences de chaque numéro et ensuite supprimer ceux dont l'occurrence est > à 1. Mais je suis resté bloquer pour récupérer les données annexes. Mon tableau a 5 colonnes, dates; NoDossier(où l'on compte les occurrences); Id(confidentiel); Idperson; Catégorie

je vais essayé avec ce que tu m'as proposé. Sinon, j'ouvrirai une discussion qui ne sera qu'une doublette de celle-ci.
Merci.
Bonne journée

 

[Dranreb]

Bonjour.
Il est complètement inutile, voire nuisible, de chercher à comprendre comment procède la fonction Gigogne pour apprendre à s'en servir. Il vaut mieux d'abord bien cerner ce qu'elle produit, parce que c'est essentiellement ça qu'on exploite derrière dans la programmation utilisatrice. Mais si ça vous intéresse par simple curiosité, je veux bien ensuite seulement vous expliquer comment elle s'y prend pour l'obtenir.

 

[cathodique]

Bonjour.
Il est complètement inutile, voire nuisible, de chercher à comprendre comment procède la fonction Gigogne pour apprendre à s'en servir. Il vaut mieux d'abord bien cerner ce qu'elle produit, parce que c'est essentiellement ça qu'on exploite derrière dans la programmation utilisatrice. Mais si ça vous intéresse par simple curiosité, je veux bien ensuite seulement vous expliquer comment elle s'y prend pour l'obtenir.

Bonjour,

Je te rejoins quant à la nuisibilité. Je t'avoue que ça m'a donné le tournis.
Pour le moment, je dois avancer sur mon petit projet. Je reviendrais surement vers toi quand j'aurai un peu plus de temps.
Merci beaucoup.

 

[cathodique]

Bonjour,

@patricktoulon , Tes solutions du post#18 donnent un résultat juste via la msgbox.
Je voudrais reporter le résultat sur une feuille de calcul.
Je t'avoue que je sèche depuis 6h.
Un coup de pouce stp.

Merci.

 

[dysorthographie]

Bonjour,
Tu trouves qu mon code était plus compliqué a comprendre et à adapter ?

Pourquoi cette gabji de code?

Public Nom As String
Public Occur As Long
Public Lastdate As Date
Public  As Double

'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
            .Occur = Occur + 1
            .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

Pourquoi ce genre de code? Qu'est-ce que ce serait si on faisait de la programmation objet

If Not Dic.Exists(cel.Text) Then
            Set cl = New Classe1
            cl.Nom = cel.Text
            cl.Occur = 1
            cl.Cumul = cel.Offset(, 1).Value
            cl.Lastdate = cel.Offset(, 3)
            Set Dic(cel.Text) = cl
        Else
            Set cl = Dic(cel.Text)
            cl.Occur = cl.Occur + 1
            cl.Cumul = cl.Cumul + cel.Offset(, 1).Value
            If cl.Lastdate < CDate(cel.Offset(, 2)) Then cl.Lastdate = cel.Offset(, 2)

        End If

Ça devient

If Not Dic.Exists(cel.Text) Then Set dic(cel.Value) = New ClsHtravail
            With Dic(cel.Text)
              .Nom = cel.Text
            .Occur = cl.Occur + 1
            .Cumul = cl.Cumul + cel.Offset(, 1).Value
            If .Lastdate < CDate(cel.Offset(, 2)) Then .Lastdate = cel.Offset(, 2)

 

[cathodique]

Bonjour @dysorthographie ,

Tu trouves qu mon code était plus compliqué a comprendre et à adapter ?

Non pas du tout. Je t'ai tout simplement informé que ton précédent donné le même résultat que le code du post#1.

Pourquoi cette gabji de code?

Cette gabegie est due à 2 choses:
1 - J'ai peut-être mal expliqué mon problème
2 - Le contributeur répond d'après ce qu'il a compris

Merci beaucoup.

Bonne journée.

 

[dysorthographie]

module ExempleClassSom

Option Explicit
Sub ResultatDictionary()
   Dim dic As Dictionary
   Dim key As Variant
  ' Dim lig As ListRow
   '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
        With .ListRows.Add
            .Range(, 1) = dic(key).Societe
            .Range(, 2) = dic(key).Occurences
            .Range(, 3) = dic(key).HeurTrav
            .Range(, 4) = dic(key).LaDate
        End With

      Next key
   End With
End Sub
'Sub RemplirDictionary()
Function RemplirDictionary() As Dictionary
'on ajoute as dictionary
'Activer bibliothèque Microsoft Runtime Scripting
 Set RemplirDictionary = 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,
    With RemplirDictionary
        If Not .Exists(cel.Value) Then .Add cel.Value, New ClsHtravail
        With .Item(cel.Value)
            ' Pour L'excercice
            .Societe = cel.Value
            .HeurTrav = cel.Offset(0, 1).Value
            .LaDate = cel.Offset(0, 2).Value
        End With
    End With
    Next cel
   'Définir la valeur de retour pour la fonction

End Function

module de classe ClsHtravail

Option Explicit

Private Nom As String
Private Cumule_HeurTrav_ As Double
Private LaDate__ As Date
Private Occurences__ As Integer
Public Property Let Societe(Value As String)
Nom = Value
Occurences__ = Occurences__ + 1
End Property
Public Property Get Societe() As String
    Societe = Nom
End Property

Public Property Let HeurTrav(Value As Double)
Cumule_HeurTrav_ = Cumule_HeurTrav_ + Value
End Property

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

Public Property Let LaDate(Value As Date)
If LaDate__ < Value Then LaDate__ = Value
End Property
Public Property Get LaDate() As Date
LaDate = LaDate__
End Property
Public Property Get Occurences() As Integer
Occurences = Occurences__
End Property

 

[cathodique]

Pourquoi ce genre de code? Qu'est-ce que ce serait si on faisait de la programmation objet

je viens juste de voir ton commentaire.
Je suppose que tu as lu en diagonale mon 1er post.
J'ai bien dit que j'ai suivi un tuto sur youtube. Le code n'est donc pas le mien. Je n'ai pas assez de connaissance, d'expérience et de pratique pour coder ce genre de truc (module de classe associé au dictionnaire).

Cependant, ton commentaire me divulgue que tu as fait un séjour sur DVP.
Tu devrais savoir que sur XLD, l'état d'esprit est très différent. On aide si on le veut et si on le peut, mais on ne se moque pas.

Je t'avoue qu'étant donné la gabegie de codes que tu avais invoqué. Je n'ai pas encore testé le tien.
Je refais un autre fichier propre pour être sûr de faire le moins de bêtise.

Merci. Bonne journée.