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
 

dysorthographie

XLDnaute Accro
Regarde ton classeur en
M3 tu as T1ChatCd
En B2 tu chat
En C1 tu as Cd
Dans ton dico("T1ChatCd")="M3"
On joue à la bataille navale
A|. B. |C
1. |. | Cd
2|Chat|15
Range(dico("T1ChtCd"))= range("C2")
On met "T1" & B2 & C1="T1ChtCd"

Regarde mon poste précédent.

J'ai un Dico pour les lignes"T1Chat","T1Chien"
Et undico pour les colonnes "Cd","Fa" etc

T'embarases pas de tableau à 20 dimensions, de module de classe vas au plus simple regarde ton tableau tu as 3 groupe de 6 lignesde N1 à N18 T1,T2,T3
 
Dernière édition:

laurent950

XLDnaute Barbatruc
Bonsoir @cathodique,

Je tiens à saluer le travail que tu fais et la persévérance dont tu fais preuve. Il est vrai que les variables comme Dictionary et Collection peuvent sembler complexes au début, surtout pour stocker des modules de classes.

Ta discussion sur les modules de classe était très bien, et je pense qu'il serait intéressant de repartir de ce modèle pour intégrer ton code.

Si cela t’intéresse, nous pourrions explorer ensemble cette piste.Je suis à ta disposition pour toute aide supplémentaire. Encore bravo pour ton travail et ton partage d’idées.

Laurent
 

cathodique

XLDnaute Barbatruc
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
Bonsoir @dysorthographie ;), Merci beaucoup pour ton code.

J'ai pris un plus de temps pour essayer de mieux le comprendre.
Pourquoi tu parcours les 3 tableaux qui sont à droite du tableau de données.
J'ai mis ces tableaux pour montrer le résultat attendu.
Je voudrais avoir ces 3 tableaux que j'ai nommé T1, T2 et T3 en mémoire. Je les mettrai moi même à l'emplacement voulu de mon document.
l'idéal serait d'avoir ces 3 tableaux résultats avec entête en mémoire.
Sinon je te dirais que je n'ai pas compris ce que font ces lignes. Et, ce malgré tes commentaires.
Code:
 ' 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
 

dysorthographie

XLDnaute Accro
Tu connais la bataille navale
A2 touché coulé
Le principe est d'avoir un dicoL pour les lignes un dicoC pour les colonnes
Celles(dicoL,dicoC)
Peux importe comment tu gères ton tableau dicoC doit contenir soit le Nº de la colonne soi sa lettre
DicoC("Fa")="M" pour notre exemple.
DicoL doit obtenir la ligne de destination pour chat par exemple avec un distinguo avec ce qui toujours dans notre exemple représente T2,2,3

Si tu utilises trois tableaux structure c'est encore plus simple
 

cathodique

XLDnaute Barbatruc
Regarde ton classeur en
M3 tu as T1ChatCd
En B2 tu chat
En C1 tu as Cd
Dans ton dico("T1ChatCd")="M3"
On joue à la bataille navale
A|. B. |C
1. |. | Cd
2|Chat|15
Range(dico("T1ChtCd"))= range("C2")
On met "T1" & B2 & C1="T1ChtCd"

Regarde mon poste précédent.

J'ai un Dico pour les lignes"T1Chat","T1Chien"
Et undico pour les colonnes "Cd","Fa" etc

T'embarases pas de tableau à 20 dimensions, de module de classe vas au plus simple regarde ton tableau tu as 3 groupe de 6 lignesde N1 à N18 T1,T2,T3
je te dis franchement, je ne te suis pas. Les données auxquelles tu fais référence normalement, elles ne devaient pas y être sur ma feuille, j'ai mis ces données pour montrer le résultat attendu.
Je ne suis pas une lumière. Je comprends (allez voilà que je vais utiliser un mot répéter par l'IA) la frustration lorsque vous descendez à votre plus bas niveau sans parvenir à atteindre mon haut.
Des fois je comprends vite, d'autres fois je peine à suivre.
 

cathodique

XLDnaute Barbatruc
Tu connais la bataille navale
A2 touché coulé
Le principe est d'avoir un dicoL pour les lignes un dicoC pour les colonnes
Celles(dicoL,dicoC)
Peux importe comment tu gères ton tableau dicoC doit contenir soit le Nº de la colonne soi sa lettre
DicoC("Fa")="M" pour notre exemple.
DicoL doit obtenir la ligne de destination pour chat par exemple avec un distinguo avec ce qui toujours dans notre exemple représente T2,2,3
Là, j'ai compris. je cherche pas à obtenir l'adresse de la cellule de destination. je n'aurai pas du mettre sur la feuille mes 3 tableau T1, T2, T3. Ils doivent être virtuels.
 

patricktoulon

XLDnaute Barbatruc
Bonjour à tous
comme je le dis toujours la programmation ou développement c'est d'abords un raisonnement
et là pour le coup chatDPT c'est pété 2/3 micro puces 😂
et malheureusement les autres ont suivi dans le même raisonnement
surtout que si on regarde de plus prêt par exemple le tableau 2024 on se rend compte que nous l'avons dans son entièreté dans le tableau(BD) donc la structure on l'a déjà
Donc si vous permettez je vous propose de faire simple TRES SIMPLE!!!
voila un code très simple ( ca fait peur tellement c'est simple)😂😂
VB:
Option Explicit
Sub test()
 
  Dim Id&, i&, c&, tx&, q&, k&, LiG&, H
  Dim t(1 To 3) 'variable tableau qui va contenir les trois tableau
    
    'création des variables tableau
    Dim T_All(1 To 4, 1 To 9): t(1) = T_All
    Dim T_2024(1 To 4, 1 To 9): t(2) = T_2024
    Dim T_2023(1 To 4, 1 To 9): t(3) = T_2023

    Feuil2.Cells.ClearContents
    
    'intégration des hearders de ROw dans les variables tableau
    For Id = 1 To 3
        t(Id)(1, 1) = "Espece"
        t(Id)(2, 1) = "Chat"
        t(Id)(3, 1) = "Chien"
        t(Id)(4, 1) = "Lapin"
    Next
    
    'récupération du tableau BD
    Dim tBG
    tBG = Range("BD")

    'Boucle sur les lignes du tableau tBG
    For i = 1 To UBound(tBG)


        'selection du tableau 1,2 ou 3 en fonction de la date en colonne 1
        Select Case True
            Case tBG(i, 1) = 2024
                tx = 2
            Case tBG(i, 1) < 2024
                tx = 3
        End Select


        'selection de la ligne chat,chien ou lapin en fonction de l'espèce
        Select Case tBG(i, 2)
            Case "Chat"
                LiG = 2
            Case "Chien"
                LiG = 3
            Case Else
                LiG = 4
        End Select


        'et maintenant on boucle sur les colonnes et on cumule dans le tableau indexé(tx)
        For c = 2 To 9
            t(tx)(LiG, c) = t(tx)(LiG, c) + tBG(i, c + 1)
            t(1)(LiG, c) = t(1)(LiG, c) + tBG(i, c + 1)
        Next


        'on met le header (entête de colonne )
        H = Range("BD[#all]")
        For k = 2 To 9
            t(1)(1, k) = H(1, k + 1)
            t(2)(1, k) = H(1, k + 1)
            t(3)(1, k) = H(1, k + 1)
        Next

    Next

    ' et maintenant on colle les tableaux sur la feuille(la feuille 2 pour cette démo)
    For q = 1 To UBound(t)
        Feuil2.Cells(1 + (6 * (q - 1)), 1).Resize(4, 9) = t(q)
    Next

End Sub
j'explique tout dans la vidéo et joins le fichier exemple

patrick;)
 

Pièces jointes

  • Les 3 Tableaux.xlsm
    23.4 KB · Affichages: 4

cathodique

XLDnaute Barbatruc
Bonjour à tous
comme je le dis toujours la programmation ou développement c'est d'abords un raisonnement
et là pour le coup chatDPT c'est pété 2/3 micro puces 😂
et malheureusement les autres ont suivi dans le même raisonnement
surtout que si on regarde de plus prêt par exemple le tableau 2024 on se rend compte que nous l'avons dans son entièreté dans le tableau(BD) donc la structure on l'a déjà
Donc si vous permettez je vous propose de faire simple TRES SIMPLE!!!
voila un code très simple ( ca fait peur tellement c'est simple)😂😂
VB:
Option Explicit
Sub test()
 
  Dim Id&, i&, c&, tx&, q&, k&, LiG&, H
  Dim t(1 To 3) 'variable tableau qui va contenir les trois tableau
  
    'création des variables tableau
    Dim T_All(1 To 4, 1 To 9): t(1) = T_All
    Dim T_2024(1 To 4, 1 To 9): t(2) = T_2024
    Dim T_2023(1 To 4, 1 To 9): t(3) = T_2023

    Feuil2.Cells.ClearContents
  
    'intégration des hearders de ROw dans les variables tableau
    For Id = 1 To 3
        t(Id)(1, 1) = "Espece"
        t(Id)(2, 1) = "Chat"
        t(Id)(3, 1) = "Chien"
        t(Id)(4, 1) = "Lapin"
    Next
  
    'récupération du tableau BD
    Dim tBG
    tBG = Range("BD")

    'Boucle sur les lignes du tableau tBG
    For i = 1 To UBound(tBG)


        'selection du tableau 1,2 ou 3 en fonction de la date en colonne 1
        Select Case True
            Case tBG(i, 1) = 2024
                tx = 2
            Case tBG(i, 1) < 2024
                tx = 3
        End Select


        'selection de la ligne chat,chien ou lapin en fonction de l'espèce
        Select Case tBG(i, 2)
            Case "Chat"
                LiG = 2
            Case "Chien"
                LiG = 3
            Case Else
                LiG = 4
        End Select


        'et maintenant on boucle sur les colonnes et on cumule dans le tableau indexé(tx)
        For c = 2 To 9
            t(tx)(LiG, c) = t(tx)(LiG, c) + tBG(i, c + 1)
            t(1)(LiG, c) = t(1)(LiG, c) + tBG(i, c + 1)
        Next


        'on met le header (entête de colonne )
        H = Range("BD[#all]")
        For k = 2 To 9
            t(1)(1, k) = H(1, k + 1)
            t(2)(1, k) = H(1, k + 1)
            t(3)(1, k) = H(1, k + 1)
        Next

    Next

    ' et maintenant on colle les tableaux sur la feuille(la feuille 2 pour cette démo)
    For q = 1 To UBound(t)
        Feuil2.Cells(1 + (6 * (q - 1)), 1).Resize(4, 9) = t(q)
    Next

End Sub
j'explique tout dans la vidéo et joins le fichier exemple

patrick;)
Bonjour Patrick,

Je n'ai pas pu suivre tes explications. Aujourd'hui, ta vidéo rame grave.
Tu as raté le gros morceaux sur ce fil
Le présent n'était qu'une introduction. Le but était d'avoir les résultats à partir de la Bd Globale.
J'espère pouvoir regarder ta vidéo lorsqu’elle ne ramera plus.

Bonne journée.
 
Dernière édition:

cathodique

XLDnaute Barbatruc
Bonjour,
Dommage que tu m'ais répondu uniquement sur l'adresse de destination du résultat et pas sur l'exactitude des données dans les cellules.

Car si je me réfère à l'autre discussion nous connaissons très précisément l'adresse des cellules cibles.
Bonjour @dysorthographie ,

Je te remercie. Oui on peut connaitre leurs positions relatives.
Comme je viens de le dire à @patricktoulon ce fil n'était qu'un prélude à la discussion où tu m'as démontré la puissance de SQL. Je t'en remercie.

Bonne journée.
 

cathodique

XLDnaute Barbatruc
En fait c'est juste de voir le sujet continuer ,qui m'a perturbé, Patrick , que je salue,avait tout de même raison de vouloir te démonter le bien fondé de sa proposition .
Avant d'ouvrir ma dernière discussion. J'avais voulu trouver une solution tout seul.
J'étais vraiment bloqué. Je trouvais que mon problème était complexe.
J'ai tenté de le découper en tâches simples à lier entre elles pour arriver à une solution viable et perenne.
Tu m'as parlé de Chatgpt, je me suis dit : "essayons". Mais il m'a pondu un code pas possible (comme par exemple faire un redim Preserve sur la 1ère dimension).
J'ai donc ouvert cette discussion pour corriger le code de l'IA😨.
Ceci pour pouvoir passer à l'étape suivante. Et tu m'as magistralement calculé en quelles lignes de code ce que je n'arrivais pas à faire depuis quelques jours.

je remercie @patricktoulon pour ses pertinentes remarques et analyses des problèmes posés.

Au fait, j'ai tant bien que mal trouvé une solution pas terrible (beaucoup de lignes codes à simplifier. amis vu la complexité, je n'ai touché à rien). Pour le partage, Je posterai ma solution sur l'autre discussion après avoir fait le ménage.

Bonne journée.
 

Discussions similaires

Réponses
3
Affichages
261

Statistiques des forums

Discussions
315 118
Messages
2 116 422
Membres
112 745
dernier inscrit
mcanas