XL 2010 Module de classe avec Dictionary

laurent950 à dit:

VB:

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

VB:

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

Code:

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

Cliquez pour agrandir...

dysorthographie à dit:

bonsoir,
de ce que j'ai compris

VB:

'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

Cliquez pour agrandir...

patricktoulon à dit:

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

VB:

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

VB:

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é

VB:

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

Cliquez pour agrandir...

Dranreb à dit:

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

VB:

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

Cliquez pour agrandir...

patricktoulon à dit:

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

Cliquez pour agrandir...

Dranreb à dit:

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.

Cliquez pour agrandir...

dysorthographie à dit:

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

Cliquez pour agrandir...

dysorthographie à dit:

Pourquoi cette gabji de code?

Cliquez pour agrandir...

dysorthographie à dit:

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

Cliquez pour agrandir...