XL 2010 Code de l'IA à corriger

cathodique

XLDnaute Barbatruc
Bonjour,

Dans l'une de mes discussions @dysorthographie m'a fait découvrir chatgpt.
Je l'ai testé et je peux dire qu'il répond juste à des questions assez simples. Un peu plus compliqué, nada..

J'ai suivi le conseil de notre ami @dysorthographie, en demandant juste un processus pour arriver à une solution.
C'est ce que j'ai fait mais au bout du compte le code proposé ne donne pas le résultat escompté.

J'ai demandé qu'à partir d'un array Tr, constitué de plusieurs linges et 10 colonnes;
Dont la 1ère colonne contient des années, la seconde des catégories et le restant des colonnes des chiffres;
de créer 3 tableaux T1, T2 et T3:
dans T1 faire le cumul par catégorie de chaque colonne (3 à 10)
dans T2 faire le cumul par catégorie de chaque colonne (3 à 10) pour l'année en cours
dans T3 faire le cumul par catégorie de chaque colonne (3 à 10) pour les années antérieures à l'année en cours

J'avoue que je n'ai pas su mettre des "debug" à toutes les étapes du code pour déceler se qui cloche.
Où se trouve la ou les erreurs dans le code ci-dessous, je précise code proposer par l'intelligence artificielle.
Je sollicite une aide humaine qui à son sens est bien plus intelligente que L'IA créée par l'humain.
En vous remerciant par avance
VB:
Option Explicit

Sub CreateTables()

   Dim Tr() As Variant
   Dim T1() As Variant
   Dim T2() As Variant
   Dim T3() As Variant

   Dim lastRow As Long
   Dim currentYear As Long
   Dim category As Variant
   Dim i As Long, j As Long
   Dim catIndex As Long
   Dim categoryDict As Object
   Dim totalDict As Object

   ' Initialisation des données (remplacez ceci par vos données réelles)
   lastRow = 10   ' Changez ceci en fonction de votre dernière ligne réelle
   ReDim Tr(1 To lastRow, 1 To 10)

   ' Remplissage d'exemple
   Tr(1, 1) = 2021: Tr(1, 2) = "A": Tr(1, 3) = 100: Tr(1, 4) = 200: Tr(1, 5) = 300: Tr(1, 6) = 400: Tr(1, 7) = 500: Tr(1, 8) = 600: Tr(1, 9) = 700: Tr(1, 10) = 800
   Tr(2, 1) = 2022: Tr(2, 2) = "B": Tr(2, 3) = 150: Tr(2, 4) = 250: Tr(2, 5) = 350: Tr(2, 6) = 450: Tr(2, 7) = 550: Tr(2, 8) = 650: Tr(2, 9) = 750: Tr(2, 10) = 850
   Tr(3, 1) = 2021: Tr(3, 2) = "A": Tr(3, 3) = 200: Tr(3, 4) = 300: Tr(3, 5) = 400: Tr(3, 6) = 500: Tr(3, 7) = 600: Tr(3, 8) = 700: Tr(3, 9) = 800: Tr(3, 10) = 900
   Tr(4, 1) = 2023: Tr(4, 2) = "C": Tr(4, 3) = 200: Tr(4, 4) = 300: Tr(4, 5) = 400: Tr(4, 6) = 500: Tr(4, 7) = 600: Tr(4, 8) = 700: Tr(4, 9) = 800: Tr(4, 10) = 900
   Tr(5, 1) = 2022: Tr(5, 2) = "A": Tr(5, 3) = 50: Tr(5, 4) = 70: Tr(5, 5) = 90: Tr(5, 6) = 110: Tr(5, 7) = 130: Tr(5, 8) = 150: Tr(5, 9) = 170: Tr(5, 10) = 190

   ' Récupérer l'année en cours
   currentYear = Year(Date)

   ' Initialiser les dictionnaires pour les totaux
   Set categoryDict = CreateObject("Scripting.Dictionary")
   Set totalDict = CreateObject("Scripting.Dictionary")

   ' Remplir les dictionnaires avec les totaux
   For i = 1 To UBound(Tr, 1)
      category = Tr(i, 2)

      ' Totaliser pour T1
      If Not categoryDict.Exists(category) Then
         categoryDict.Add category, Array(0, 0)   ' (Total T1, Total T2)
      End If

      For j = 3 To 10
         categoryDict(category)(0) = categoryDict(category)(0) + Tr(i, j)   ' calcul du total T1
      Next j

      ' Totaliser pour T2 si c'est l'année en cours
      If Tr(i, 1) = currentYear Then
         For j = 3 To 10
            categoryDict(category)(1) = categoryDict(category)(1) + Tr(i, j)   ' calcul du total T2
         Next j
      End If

      ' Totaliser pour T3 (années antérieures)
      If Tr(i, 1) < currentYear Then
         If Not totalDict.Exists(category) Then
            totalDict.Add category, 0   ' Initialiser à 0 pour T3
         End If
         For j = 3 To 10
            totalDict(category) = totalDict(category) + Tr(i, j)   ' calcul du total T3
         Next j
      End If
   Next i

   ' Dimensionner T1, T2 et T3 selon le nombre de catégories
   Dim catCount As Long
   catCount = categoryDict.count

   ReDim T1(1 To catCount, 1 To 10)   ' Dimensionner T1
   ReDim T2(1 To catCount, 1 To 10)   ' Dimensionner T2
   ReDim T3(1 To catCount, 1 To 10)   ' Dimensionner T3

   ' Remplir T1 et T2
   catIndex = 1
   For Each category In categoryDict.Keys
      T1(catIndex, 1) = category   ' Colonne 1 : Catégorie
      T1(catIndex, 2) = categoryDict(category)(0)   ' Colonne 2 : Total T1

      T2(catIndex, 1) = category   ' Colonne 1 : Catégorie
      T2(catIndex, 2) = categoryDict(category)(1)   ' Colonne 2 : Total T2

       Remplir les colonnes 3 à 10 avec 0
      For j = 3 To 10
         T1(catIndex, j) = 0   ' Initialisation des colonnes à 0
         T2(catIndex, j) = 0
      Next j

      catIndex = catIndex + 1
   Next category

   ' Remplir T3
   catIndex = 1
   For Each category In totalDict.Keys
      T3(catIndex, 1) = category   ' Colonne 1 : Catégorie
      T3(catIndex, 2) = totalDict(category)   ' Total T3 pour la catégorie

      ' Remplir les colonnes 3 à 10 avec 0
      For j = 3 To 10
         T3(catIndex, j) = 0   ' Initialisation des colonnes à 0
      Next j

      catIndex = catIndex + 1
   Next category

   ' Afficher les résultats dans la fenêtre de débogage
   Debug.Print "Résultats de T1 :"
   For i = 1 To UBound(T1, 1)
      For j = 1 To 10
         Debug.Print T1(i, j);
      Next j
      Debug.Print   ' Nouvelle ligne pour chaque catégorie
   Next i

   Debug.Print "Résultats de T2 :"
   For i = 1 To UBound(T2, 1)
      For j = 1 To 10
         Debug.Print T2(i, j);
      Next j
      Debug.Print   ' Nouvelle ligne pour chaque catégorie
   Next i

   Debug.Print "Résultats de T3 :"
   For i = 1 To UBound(T3, 1)
      For j = 1 To 10
         Debug.Print T3(i, j);
      Next j
      Debug.Print   ' Nouvelle ligne pour chaque catégorie
   Next i

End Sub
 

cathodique

XLDnaute Barbatruc
Hello,
Question bête : pourquoi veux-tu faire cela en VBA avec des array plutôt que de faire ça dans un tableau structuré dans une feuille ce qui à mon avis serait bien plus simple ?
Ami calmant, J.P
Après un traitement de données à partir d'un tableau structuré en guise de BD. j'ai regroupé les données qui m’intéresse dans un array. je voudrais poursuivre mon traitement en utilisant l'array précédemment obtenu.

Tu vois bien qu'au départ, je commence d'un tableau structuré que je ne veux plus y toucher.

Ma question est surtout de savoir où l'IA s'est trompée. Parce que le processus qu'elle m'avait d'après moi tenait la route. Je dis bien d'après moi, sinon je ne serai pas entrain de poser des questions ici.
 

jurassic pork

XLDnaute Occasionnel
Hello,
ben en fait ta demande n'est pas très claire et l'I.A dans ce cas ne va pas proposer forcément une réponse adéquate. Montre nous ce que tu attends dans les tableaux T1, T2 ,T3 : nombres de colonnes, nombres de lignes et contenu par rapport aux données qui sont dans le code VBA du #1.
Ami calmant, J.P
 

cathodique

XLDnaute Barbatruc
Hello,
ben en fait ta demande n'est pas très claire et l'I.A dans ce cas ne va pas proposer forcément une réponse adéquate. Montre nous ce que tu attends dans les tableaux T1, T2 ,T3 : nombres de colonnes, nombres de lignes et contenu par rapport aux données qui sont dans le code VBA du #1.
Ami calmant, J.P
Hello,
Comme je suis assez gauche. Je n'arrive même pas à me faire comprendre par une IA.
J'ai donné mes explications à la suite du retour du process. Il m'a semblé tenir la route. j'ai poursuivi en demande un code. Au final, le code ne cumul qu'une colonne et pour une seule condition.
J'espère que tu comprendras mieux avec le fichier joint.
Merci.
 

Pièces jointes

  • Les 3 Tableaux.xlsm
    16.8 KB · Affichages: 8

jurassic pork

XLDnaute Occasionnel
Bon j'ai posé ce problème à ChatGpt :
vba tableau qui contient 10 colonnes et des lignes la première colonne contient des années . la deuxième contient des espèces d'animaux et les 8 autres des données chiffres. Créer 3 tableaux qui contiennent la somme des colonnes chiffres par espèces. Le premier tableau regroupe toutes les années. Le deuxième l'année en cours. Le troisième les années antérieures à l'année en cours
Il m'a sorti du code qui m'a l'air pas trop mal :
Sub CreerTableauxSommes()

' Définir les variables
Dim ws As Worksheet
Dim rng As Range
Dim LastRow As Long
Dim currentYear As Integer
Dim animal As String
Dim i As Long, j As Long

' Définir la feuille contenant les données initiales
Set ws = ThisWorkbook.Sheets("Feuil1") ' Remplacer par le nom de votre feuille
LastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).row ' Trouver la dernière ligne utilisée

' Obtenir l'année en cours
currentYear = Year(Date)

' Créer des dictionnaires pour stocker les sommes
Dim sumAllYears As Object
Dim sumCurrentYear As Object
Dim sumPreviousYears As Object

Set sumAllYears = CreateObject("Scripting.Dictionary")
Set sumCurrentYear = CreateObject("Scripting.Dictionary")
Set sumPreviousYears = CreateObject("Scripting.Dictionary")

' Parcourir les données initiales
For i = 2 To LastRow ' Commencer à la ligne 2, en supposant que la ligne 1 contient les en-têtes
animal = ws.Cells(i, 2).Value

' Initialiser les sommes pour cet animal si elles n'existent pas déjà
If Not sumAllYears.Exists(animal) Then
sumAllYears(animal) = ws.Cells(i, 3).Resize(, 8).Value
sumCurrentYear(animal) = ws.Cells(i, 3).Resize(, 8).Value
sumPreviousYears(animal) = ws.Cells(i, 3).Resize(, 8).Value
Else
For j = 1 To 8
sumAllYears(animal)(1, j) = sumAllYears(animal)(1, j) + ws.Cells(i, j + 2).Value
Next j

If ws.Cells(i, 1).Value = currentYear Then
For j = 1 To 8
sumCurrentYear(animal)(1, j) = sumCurrentYear(animal)(1, j) + ws.Cells(i, j + 2).Value
Next j
ElseIf ws.Cells(i, 1).Value < currentYear Then
For j = 1 To 8
sumPreviousYears(animal)(1, j) = sumPreviousYears(animal)(1, j) + ws.Cells(i, j + 2).Value
Next j
End If
End If
Next i
' Créer les tableaux de sortie
' Dim wsAllYears As Worksheet
' Dim wsCurrentYear As Worksheet
' Dim wsPreviousYears As Worksheet

' Ajouter des feuilles pour les résultats
' Set wsAllYears = ThisWorkbook.Sheets.Add
' wsAllYears.Name = "SommeToutesAnnees"

' Set wsCurrentYear = ThisWorkbook.Sheets.Add
' wsCurrentYear.Name = "SommeAnneeEnCours"

' Set wsPreviousYears = ThisWorkbook.Sheets.Add
' wsPreviousYears.Name = "SommeAnneesPrecedentes"

' Remplir les tableaux de sortie
' RemplirTableau wsAllYears, sumAllYears
' RemplirTableau wsCurrentYear, sumCurrentYear
' RemplirTableau wsPreviousYears, sumPreviousYears

End Sub

Sub RemplirTableau(ws As Worksheet, dataDict As Object)
Dim row As Integer
Dim animal As Variant

' Initialiser les en-têtes
ws.Cells(1, 1).Value = "Espèce"
For i = 1 To 8
ws.Cells(1, i + 1).Value = "Colonne " & (i + 2)
Next i

' Remplir les données
row = 2
For Each animal In dataDict.Keys
ws.Cells(row, 1).Value = animal
ws.Cells(row, 2).Resize(, 8).Value = dataDict(animal)
row = row + 1
Next animal
End Sub

Le souci c'est que les additions dans les dictionnaires n'ont pas l'air de fonctionner.
Ce qui est bien c'est qu'il met des commentaires et des noms de variables explicites.
 
Dernière édition:

cathodique

XLDnaute Barbatruc
Le souci c'est que les additions dans les dictionnaires n'ont pas l'air de fonctionner.
C'est ce que j'ai constaté. Je suis autodidacte, beaucoup de chose m'échappe pour pouvoir corriger le code proposé par l'IA. En ce qui me concerne, je viens de découvrir et je n'en raffolerai pas.
Je préfère mon bon vieux XLD.
Ce qui est bien c'est qu'il met des commentaires et des noms de variables explicites.
oui, les commentaires sont dans la langue de Molières. Un petit tour sur Google traduction et on a la signification. Quant aux variables, je te laisse découvrir que ce n'est pas top. Il définit très souvent certaines variables en string alors que c'est un objet ou un variant qui est attendu.

Pour ma part, j'ai découvert, j'ai testé, j'ai mon idée.
 

jurassic pork

XLDnaute Occasionnel
Si quelqu'un qui connaît bien les dictionnaires peut dire pourquoi cette ligne ne fonctionne pas :
sumAllYears(animal)(1, j) = sumAllYears(animal)(1, j) + ws.Cells(i, j + 2).Value
sumAllYears est un dictionnaire : l'addition ne fonctionne pas : pas de message d'erreur mais dans le dictionnaire on ne retrouve pas la somme des valeurs mais l'ancienne valeur
 

cathodique

XLDnaute Barbatruc
Si quelqu'un qui connaît bien les dictionnaires peut dire pourquoi cette ligne ne fonctionne pas :

sumAllYears est un dictionnaire : l'addition ne fonctionne pas : pas de message d'erreur mais dans le dictionnaire on ne retrouve pas la somme des valeurs mais l'ancienne valeur
Il faut demander à L'IA. tu recevras à chaque coup, un message te disant que le code a été corrigé.
J'ai mis du temps pour m'apercevoir que je recevais le même code. Bon courage.
 

dysorthographie

XLDnaute Accro
Bonsoir,
Code:
Sub Test()
    Dim DicoT As Object, DicoC As Object
    Dim I As Integer, C As Integer

    ' Création de deux objets Dictionnaire pour stocker les références
    Set DicoT = CreateObject("Scripting.Dictionary")' pour sauvegarder les lignes T1,T2,T3:Espèce;Chat;Chien;Lapin
    Set DicoC = CreateObject("Scripting.Dictionary") 'Porur sauvegarder les colonnes Cd;Fa;Ad;Ch;Adoptable;Non Adoptable;À Déterminer;Nb Décès


    ' Initialisation de la variable I à 12
    I = 12

    ' Remplissage du dictionnaire DicoC avec des paires clé/valeur basées sur les colonnes définies
    For Each d In Split("Cd;Fa;Ad;Ch;Adoptable;Non Adoptable;À Déterminer;Nb Décès", ";")
        I = I + 1
        DicoC(d) = I
    Next

    ' Parcours des lignes 1 à 18, avec un pas de 6 pour chaque itération
    For I = 1 To 18 Step 6
        With Sheets("Feuil1")
            ' Remplissage du dictionnaire DicoT avec les valeurs de cellules et leurs positions
            DicoT(.Cells(I, "L").Text & .Cells(I, "L").Offset(2).Text) = .Cells(I, "L").Offset(2).Row
            DicoT(.Cells(I, "L").Text & .Cells(I, "L").Offset(3).Text) = .Cells(I, "L").Offset(3).Row
            DicoT(.Cells(I, "L").Text & .Cells(I, "L").Offset(4).Text) = .Cells(I, "L").Offset(4).Row

           ' Effacement des cellules de la colonne 13 (M) à la colonne 20 (T) sur les lignes concernées
            .Range(.Cells(I, "M").Offset(2), .Cells(I, "T").Offset(5)) = ""
        End With
    Next

    ' Parcours de toutes les lignes de la plage utilisée dans "Feuil1" pour calculer et stocker les résultats
    With Sheets("Feuil1").Range("A1").CurrentRegion
        For I = 2 To .Rows.Count  ' Commence à la deuxième ligne pour ignorer les en-têtes
            For C = 3 To .Columns.Count  ' Parcours des colonnes de la troisième à la dernière
                
                ' Ajoute la valeur actuelle à la cellule correspondante pour T1
                .Cells(DicoT("T1" & .Cells(I, "B").Text), DicoC(.Cells(1, C).Text)) = _
                    .Cells(DicoT("T1" & .Cells(I, "B").Text), DicoC(.Cells(1, C).Text)) + Cells(I, C)

                ' Si l'année dans la colonne A correspond à l'année en cours, ajoute la valeur à T2
                If .Cells(I, "A") = Year(Date) Then
                    .Cells(DicoT("T2" & .Cells(I, "B").Text), DicoC(.Cells(1, C).Text)) = _
                        .Cells(DicoT("T2" & .Cells(I, "B").Text), DicoC(.Cells(1, C).Text)) + Cells(I, C)
                End If

                ' Si l'année dans la colonne A ne correspond pas à l'année en cours, ajoute la valeur à T3
                If .Cells(I, "A") <> Year(Date) Then
                    .Cells(DicoT("T3" & .Cells(I, "B").Text), DicoC(.Cells(1, C).Text)) = _
                        .Cells(DicoT("T3" & .Cells(I, "B").Text), DicoC(.Cells(1, C).Text)) + Cells(I, C)
                End If

            Next C
        Next I
    End With
End Sub
 
Dernière édition:

jurassic pork

XLDnaute Occasionnel
Si quelqu'un qui connaît bien les dictionnaires peut dire pourquoi cette ligne ne fonctionne pas :

sumAllYears est un dictionnaire : l'addition ne fonctionne pas : pas de message d'erreur mais dans le dictionnaire on ne retrouve pas la somme des valeurs mais l'ancienne valeur
Bon ben j'ai trouvé sans l'I.A ce qui clochait on ne peut pas changer directement une valeur de tableau dans un dictionnaire de tableau . Il faut passer par un tableau temporaire :
VB:
            tempArr = sumAllYears(animal)
            For j = 1 To 8
                    tempArr(1, j) = tempArr(1, j) + ws.Cells(i, j + 2).Value
            Next j
            sumAllYears(animal) = tempArr
Il y avait aussi d'autres erreurs dans le code de l'I.A . Voici le code qui semble fonctionner chez moi ( crée trois feuilles avec les tableaux résultats) :
VB:
Sub CreerTableauxSommes()
    ' Définir les variables
    Dim ws As Worksheet
    Dim rng As Range
    Dim LastRow As Long
    Dim currentYear As Integer
    Dim animal As String
    Dim i As Long, j As Long
   
    ' Définir la feuille contenant les données initiales
    Set ws = ThisWorkbook.Sheets("Feuil1") ' Remplacer par le nom de votre feuille
    LastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).row ' Trouver la dernière ligne utilisée
   
    ' Obtenir l'année en cours
    currentYear = Year(Date)
   
    ' Créer des dictionnaires pour stocker les sommes
    Dim sumAllYears As Object
    Dim sumCurrentYear As Object
    Dim sumPreviousYears As Object
    Dim tempArr
   
    Set sumAllYears = CreateObject("Scripting.Dictionary")
    Set sumCurrentYear = CreateObject("Scripting.Dictionary")
    Set sumPreviousYears = CreateObject("Scripting.Dictionary")
   
    ' Parcourir les données initiales
    For i = 2 To LastRow ' Commencer à la ligne 2, en supposant que la ligne 1 contient les en-têtes
        animal = ws.Cells(i, 2).Value
       
        ' Initialiser les sommes pour cet animal si elles n'existent pas déjà
        If Not sumAllYears.Exists(animal) Then
            sumAllYears(animal) = ws.Cells(i, 3).Resize(, 8).Value
        Else
            tempArr = sumAllYears(animal)
            For j = 1 To 8
                    tempArr(1, j) = tempArr(1, j) + ws.Cells(i, j + 2).Value
            Next j
            sumAllYears(animal) = tempArr
        End If
           
        If ws.Cells(i, 1).Value = currentYear Then
            If Not sumCurrentYear.Exists(animal) Then
                    sumCurrentYear(animal) = ws.Cells(i, 3).Resize(, 8).Value
            Else
                tempArr = sumCurrentYear(animal)
                For j = 1 To 8
                    tempArr(1, j) = tempArr(1, j) + ws.Cells(i, j + 2).Value
                Next j
                sumCurrentYear(animal) = tempArr
            End If
        ElseIf ws.Cells(i, 1).Value < currentYear Then
            If Not sumPreviousYears.Exists(animal) Then
                    sumPreviousYears(animal) = ws.Cells(i, 3).Resize(, 8).Value
            Else
                tempArr = sumPreviousYears(animal)
                For j = 1 To 8
                    tempArr(1, j) = tempArr(1, j) + ws.Cells(i, j + 2).Value
                Next j
                sumPreviousYears(animal) = tempArr
            End If
      End If
    Next i
   
    ' Créer les tableaux de sortie
    Dim wsAllYears As Worksheet
    Dim wsCurrentYear As Worksheet
    Dim wsPreviousYears As Worksheet
   
    ' Ajouter des feuilles pour les résultats
    Set wsAllYears = ThisWorkbook.Sheets.Add
    wsAllYears.Name = "SommeToutesAnnees"
   
    Set wsCurrentYear = ThisWorkbook.Sheets.Add
    wsCurrentYear.Name = "SommeAnneeEnCours"
   
    Set wsPreviousYears = ThisWorkbook.Sheets.Add
    wsPreviousYears.Name = "SommeAnneesPrecedentes"
   
    ' Remplir les tableaux de sortie
    RemplirTableau wsAllYears, sumAllYears
    RemplirTableau wsCurrentYear, sumCurrentYear
    RemplirTableau wsPreviousYears, sumPreviousYears


End Sub


Sub RemplirTableau(ws As Worksheet, dataDict As Object)
    Dim row As Integer
    Dim animal As Variant
   
    ' Initialiser les en-têtes
    ws.Cells(1, 1).Value = "Espèce"
    For i = 1 To 8
        ws.Cells(1, i + 1).Value = "Colonne " & (i + 2)
    Next i
   
    ' Remplir les données
    row = 2
    For Each animal In dataDict.Keys
        ws.Cells(row, 1).Value = animal
        ws.Cells(row, 2).Resize(, 8).Value = dataDict(animal)
        row = row + 1
    Next animal
End Sub
 

cathodique

XLDnaute Barbatruc
Bonsoir @dysorthographie , @jurassic pork ,

Je n'ai pas encore testé vos propositions. Comme l'IA m'a tourné en bourrique, j'ai creusé de mon côté. Un truc avec module de classe, il manque 2 procédures pour les 2 autres tableaux.
Dans module standard
VB:
Option Explicit

Private Sub CreerRapport1()

   Dim dict As New Dictionary, Tg(), i As Long
   Dim Espèce As String, Esp As ClsEsp

   Tg = [tablo].Value

   ' parcourir  les données
   For i = 1 To UBound(Tg)
      If Tg(i, 1) = 2024 Then
         ' Récupérer l'Espèce
         Espèce = Tg(i, 2)
         ' ' Vérifier si l'Espèce existe déjà dans le Dictionnaire
         If dict.Exists(Espèce) = False Then
            Set Esp = New ClsEsp
            Esp.Espèce = Espèce
            dict.Add key:=Esp.Espèce, Item:=Esp
         Else
            ' Si elle est dans le dictionnaire, alors récupérer dans la variable Esp
            Set Esp = dict(Espèce)
         End If

         ' Mettre à jour les valeurs
         With Esp
            .Cd = .Cd + Tg(i, 3)
            .Fa = .Fa + Tg(i, 4)
            .Ad = .Ad + Tg(i, 5)
            .Ch = .Ch + Tg(i, 6)
            .Rt = .Rt + Tg(i, 7)
            .Adoptable = .Adoptable + Tg(i, 8)
            .Non_Adoptable = .Non_Adoptable + Tg(i, 9)
            .Décès = .Décès + Tg(i, 10)
         End With
      End If

   Next i
   ' Écrire les données dans la feuille de calcul
   Call TransfertVersFeuille(dict)

End Sub

Sub TransfertVersFeuille(dict As Dictionary)

' ' Définir la plage de sortie
   Dim rg As Range
   Set rg = Feuil5.Range("L10")

   ' Effacer le contenu existant. Utiliser l'offset pour descendre
' d'une ligne et éviter l'en-tête
   rg.CurrentRegion.Offset(1).ClearContents

   Dim key As Variant, Esp As ClsEsp
   Dim row As Long
   row = 1

   ' On parcourt les clés du Dictionnaire
   For Each key In dict.Keys

      ' Obtenir l'objet clsEsp à la clé actuelle
      Set Esp = dict(key)

     ' Écrire les valeurs de clsEsp dans la feuille de calcul
      With Esp
         rg.Cells(row, 1).Value = .Espèce
         rg.Cells(row, 2).Value = .Cd
         rg.Cells(row, 3).Value = .Fa
         rg.Cells(row, 4).Value = .Ad
         rg.Cells(row, 5).Value = .Ch
         rg.Cells(row, 6).Value = .Rt
         rg.Cells(row, 7).Value = .Adoptable
         rg.Cells(row, 8).Value = .Non_Adoptable
         rg.Cells(row, 9).Value = .Décès
         row = row + 1
      End With
   Next key
End Sub
dans module de classe
Code:
Option Explicit
'classe nommée ClsEsp

Public Espèce As String
Public Cd As Integer
Public Fa As Integer
Public Ad As Integer
Public Ch As Integer
Public Rt As Integer
Public Adoptable As Integer
Public Non_Adoptable As Integer
Public Décès As Integer

Merci beaucoup pour votre implication.
Bonne soirée

Bonne soirée
 

laurent950

XLDnaute Barbatruc
Bonsoir @cathodique

Il faut stocker les données via un module de classe, puis une fois la classe remplie stocker celle-ci dans une variable (Dictionary/collection) au choix

Puis utiliser le module de classe pour récupérer les données correspondante déjà remplie dans la classe correspondante à la clé du (Dictionary/collection) au choix

On avait déjà fait cela sur une de vos discussions.

Il faut repartir de votre discussion pour modèle.
 

cathodique

XLDnaute Barbatruc
Bon ben j'ai trouvé sans l'I.A ce qui clochait on ne peut pas changer directement une valeur de tableau dans un dictionnaire de tableau . Il faut passer par un tableau temporaire :
VB:
            tempArr = sumAllYears(animal)
            For j = 1 To 8
                    tempArr(1, j) = tempArr(1, j) + ws.Cells(i, j + 2).Value
            Next j
            sumAllYears(animal) = tempArr
Il y avait aussi d'autres erreurs dans le code de l'I.A . Voici le code qui semble fonctionner chez moi ( crée trois feuilles avec les tableaux résultats) :
VB:
Sub CreerTableauxSommes()
    ' Définir les variables
    Dim ws As Worksheet
    Dim rng As Range
    Dim LastRow As Long
    Dim currentYear As Integer
    Dim animal As String
    Dim i As Long, j As Long
  
    ' Définir la feuille contenant les données initiales
    Set ws = ThisWorkbook.Sheets("Feuil1") ' Remplacer par le nom de votre feuille
    LastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).row ' Trouver la dernière ligne utilisée
  
    ' Obtenir l'année en cours
    currentYear = Year(Date)
  
    ' Créer des dictionnaires pour stocker les sommes
    Dim sumAllYears As Object
    Dim sumCurrentYear As Object
    Dim sumPreviousYears As Object
    Dim tempArr
  
    Set sumAllYears = CreateObject("Scripting.Dictionary")
    Set sumCurrentYear = CreateObject("Scripting.Dictionary")
    Set sumPreviousYears = CreateObject("Scripting.Dictionary")
  
    ' Parcourir les données initiales
    For i = 2 To LastRow ' Commencer à la ligne 2, en supposant que la ligne 1 contient les en-têtes
        animal = ws.Cells(i, 2).Value
      
        ' Initialiser les sommes pour cet animal si elles n'existent pas déjà
        If Not sumAllYears.Exists(animal) Then
            sumAllYears(animal) = ws.Cells(i, 3).Resize(, 8).Value
        Else
            tempArr = sumAllYears(animal)
            For j = 1 To 8
                    tempArr(1, j) = tempArr(1, j) + ws.Cells(i, j + 2).Value
            Next j
            sumAllYears(animal) = tempArr
        End If
          
        If ws.Cells(i, 1).Value = currentYear Then
            If Not sumCurrentYear.Exists(animal) Then
                    sumCurrentYear(animal) = ws.Cells(i, 3).Resize(, 8).Value
            Else
                tempArr = sumCurrentYear(animal)
                For j = 1 To 8
                    tempArr(1, j) = tempArr(1, j) + ws.Cells(i, j + 2).Value
                Next j
                sumCurrentYear(animal) = tempArr
            End If
        ElseIf ws.Cells(i, 1).Value < currentYear Then
            If Not sumPreviousYears.Exists(animal) Then
                    sumPreviousYears(animal) = ws.Cells(i, 3).Resize(, 8).Value
            Else
                tempArr = sumPreviousYears(animal)
                For j = 1 To 8
                    tempArr(1, j) = tempArr(1, j) + ws.Cells(i, j + 2).Value
                Next j
                sumPreviousYears(animal) = tempArr
            End If
      End If
    Next i
  
    ' Créer les tableaux de sortie
    Dim wsAllYears As Worksheet
    Dim wsCurrentYear As Worksheet
    Dim wsPreviousYears As Worksheet
  
    ' Ajouter des feuilles pour les résultats
    Set wsAllYears = ThisWorkbook.Sheets.Add
    wsAllYears.Name = "SommeToutesAnnees"
  
    Set wsCurrentYear = ThisWorkbook.Sheets.Add
    wsCurrentYear.Name = "SommeAnneeEnCours"
  
    Set wsPreviousYears = ThisWorkbook.Sheets.Add
    wsPreviousYears.Name = "SommeAnneesPrecedentes"
  
    ' Remplir les tableaux de sortie
    RemplirTableau wsAllYears, sumAllYears
    RemplirTableau wsCurrentYear, sumCurrentYear
    RemplirTableau wsPreviousYears, sumPreviousYears


End Sub


Sub RemplirTableau(ws As Worksheet, dataDict As Object)
    Dim row As Integer
    Dim animal As Variant
  
    ' Initialiser les en-têtes
    ws.Cells(1, 1).Value = "Espèce"
    For i = 1 To 8
        ws.Cells(1, i + 1).Value = "Colonne " & (i + 2)
    Next i
  
    ' Remplir les données
    row = 2
    For Each animal In dataDict.Keys
        ws.Cells(row, 1).Value = animal
        ws.Cells(row, 2).Resize(, 8).Value = dataDict(animal)
        row = row + 1
    Next animal
End Sub
Je viens de tester, les résultats sont bons. ça aurait parfait s'il y avait le bon entête mais je pourrais m'en sortir. Merci beaucoup.
Bonne soirée
 

cathodique

XLDnaute Barbatruc
Bonsoir @cathodique

Il faut stocker les données via un module de classe, puis une fois la classe remplie stocker celle-ci dans une variable (Dictionary/collection) au choix

Puis utiliser le module de classe pour récupérer les données correspondante déjà remplie dans la classe correspondante à la clé du (Dictionary/collection) au choix

On avait déjà fait cela sur une de vos discussions.

Il faut repartir de votre discussion pour modèle.
Bonsoir @laurent950 ,

Je te remercie pour ces rappels. Tu sais mes capacités déclinent de jour en jour.
Assez souvent maintenant, je demande le jour qu'on est.
Je vais reconsulter mes précédentes discussions. J'avoue que j'ai du mal à tout bien assimiler et surtout à retenir.

Bonne soirée.
 

Discussions similaires

Réponses
3
Affichages
159
Réponses
4
Affichages
343

Statistiques des forums

Discussions
313 866
Messages
2 103 082
Membres
108 521
dernier inscrit
manouba