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.

 

[Dranreb]

Oui mais elle n'est pas difficile à paramétrer la fonction Gigogne, il faut indiquer la source puis une série de numéros des colonnes de regroupements désirées.

 

[jclaborde]

Vous ne devez pas avoir le module MGigogne non plus alors, logiquement …
Tout est là dedans :

👍👍👍
merci

 

[patricktoulon]

bonjour @cathodique
je t'ai donné 2 solutions avec ou sans classe
je les ai faites de façon a ce que ce soit le plus compréhensible pour un débutant dans le domaine des modules classe
commence par apprendre a gérer des classes simples
ou
à bien comprendre comment fonctionne le dictionnaire

 

[cathodique]

bonjour @cathodique
je t'ai donné 2 solutions avec ou sans classe
je les ai faites de façon a ce que ce soit le plus compréhensible pour un débutant dans le domaine des modules classe
commence par apprendre a gérer des classes simples
ou
à bien comprendre comment fonctionne le dictionnaire

Bonjour @patricktoulon 😉,

T'inquiète! J'ai déjà utilisé ton code sans module de classe dans un autre classeur sans problème.
c-à-d dire la solution avec le dictionnaire. Au fait, il plantait sur cette ligne

myarray(0) = Dico(cel.Text)

J'ai retiré le zéro avec les parenthèses et code s’exécute très bien.
Honnêtement, je n'ai pas compris le pourquoi de la chose.
J'ai juste revisionné ta vidéo pour constater qu'il n'y avait pas (0).

Encore merci pour ton partage.
bonne journée.

 

[patricktoulon]

re
oui au départ si ca n'existe p"as dans le dico
dico(cel.text)=array(x,x,x,x)
si ca existe
on modifie l'array

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

autrement dit je met les 4 valeur dans l'array
je prend ce que j'ai besoins après dedans selon le tableau
et la classe je fait exactement pareil

 

[Dranreb]

Bonjour.

faut-t-il ajouter une référence ?

Notez que j'ai bien réalisé un .xlam pourvu d'un projet VBA nommé GigIdx que l'on pourrait cocher dans les Références. Mais j'ai été dégouté de le proposer en téléchargement parce que je voyais que de plus en plus de gens utilisaient systématiquement Power Query (sans rien savoir non plus de la façon dont il fonctionne et en imposant de surcroît un nouveau langage) pour toutes les solutions que ma fonction Gigogne pouvait apporter d'une façon bien plus facile à mettre en œuvre.

 

[patricktoulon]

@Dranreb
et ben défend ton opinion sur cette question justement en proposant des alternatives vba
de plus entre nous je ne suis pas sur que PQ soit plus facile
d'une part son langage qui est un hybride du json Javascript et .net
d'autre part les automatismes ne sont pas si automatique que ça
quand à l'intuitivité elle réside en un code verbeux

donc ta classe a parfaitement sa place dans les ressources