XL 2010 Comptage Complexe

[cathodique]

Bonjour,
Depuis une petite BD (qui s'allongera au fil du temps), je voudrais via un formulaire faire un comptage global ou par année suivant un choix dans la combobox.

Je voudrai faire un comptage dans l'ordre suivant par Espèce, par Cat. (catégorie) et par caractère. et aussi compter le nombre de décès par année (colonne F contient la date de décès).

Attention, pour caractere, ils sont en doublons car chaque NoDossier peut changer de cat. au fil du temps.

Pour info, un NoDossier n'a jamais de catégorie "Cd" en doublon. Ce qui n'est pas le cas de autres Catégories.

Je ne sais pas si j'ai bien expliqué mon objectif. En feuille Recap, j'ai mis les différents résultats escomptés.

J'ai commencé comme ci-dessous mais je me suis emmêlé les pinceaux.

Option Explicit
Dim tb
Dim Dico As Object

Sub essai1()
   Dim i As Long, d As Object, L As Byte
   Dim année
   Set d = CreateObject("scripting.dictionary")

   tb = [Table].Value
   année = 2024 ' sera remplacé par la combobox

   For i = 1 To UBound(tb)
      d(tb(i, 4)) = "" 'récupère nb espèce sans doublon
   Next i

   Dim Tr() 'debut tableau resultat
   For i = 0 To d.Count - 1
      ReDim Preserve Tr(1 To d.Count, 1 To 10)
      Tr(i + 1, 1) = année
      Tr(i + 1, 2) = d.keys()(i)
   Next i

   For i = 1 To UBound(tb)
      If Year(tb(i, 1)) = année Then
'je me noie ici

      End If
   Next i
End Sub

J'ai voulu adapter les exemples (de ma précédente discussion )de @patricktoulon , de @laurent950 ou de @dysorthographie (la plus complexe pour moi car jamais utilisé ADO).
Je voudrai en gros obtenir le modèle d'array en feuille Recap pour alimenter la listbox.

En vous remerciant par avance.

 

[vgendron]

Hello
pourquoi ne pas utiliser un TCD ?

 

[mapomme]

Bonjour @cathodique ,

Argotiquement parlé, mézigo entrave que pouic à ta demande .

 

[mapomme]

Attention, pour caractere, ils sont en doublons car chaque NoDossier peut changer de cat. au fil du temps.

C'est sympa. de nous le préciser et que fait-on de cette information ?
On les prend tous en compte, on ne prend que le premier, que le dernier ?

Et où doit se trouver le résultat ? Sur la feuille résultat (un seul tableau ? les tableaux pour toutes les années ? Autre chose ?) ou bien ailleurs que sur la feuille résultat ?

A quoi sert la Listbox et que met-on dans cette Listbox ?

Je ne sais plus, moi là... Je ne sais plus!

edit : bonjour @TooFatBoy .

 

[TooFatBoy]

Bonjour,

Hello my apple,

Je ne sais plus, moi là... Je ne sais plus!

Moi, quand je ne sais pas, je ne sais plus, je suis perdu, je fais comme l'oiseau : je plane et je me tire (d'ailes, bien sûr).

 

[cathodique]

Messieurs bonjour,

Je vous remercie d'avoir consulté et de m'avoir répondu.
Je m'excuse aussi pour mon retard.
Comme bien souvent, je m'y prends comme un pied.
Je vais essayer d'être moins pouic .
La Listbox devrait afficher ci-dessous
avec comme entete de colonnes dans des labels (ou listbox d'une ligne)

Au final, à partir de la bd compter par année et par espèce, le nombre d'occurrence pour chaque catégorie en colonne C (Cd, Fa, Ad, Ch, Rt) cette dernière n'est pas encore présente dans la bd mais il faut la prendre en compte pour lui réserver sa colonne dans la listbox.
Et compter le nombre d'adoptable et non adoptable (colonne E) par année pour chaque espèce
et enfin le nombre de décès par espèces (colonne F dans celle-ci il y a la date de décès).
là, il y a une difficulté.
Pour le moment, en colonne F, il y a sur 2 lignes la même date qui concerne le même animal (Nodossier=2020087), arrivé à l'association le 10/04/2020, à l'entrée on lui affecte la catégorie Cd,
mit en famille d'accueil le même jour, on lui affecte la catégorie Fa. Il est comptabilisé pour les autres catégorie en 2020. Mais son décès doit être comptabilisé en 2024, parce qu'il est décédé en 2024.

En espérant être moins pouic

Merci beaucoup.

 

[vgendron]

Je réitère.. pourquoi pas par TCD ?

 

[cathodique]

Je réitère.. pourquoi pas par TCD ?

Bonjour @vgendron ,

Très gentil de ta part. Mais ce n'est pas vraiment ce que je veux.
Le but est d'alimenter une listbox. En plus ton TCD n'est pas juste, il manque la catégorie Ch.
le nombre d'adoptable, non adoptable et décès.
Merci beaucoup.

 

[vgendron]

En plus ton TCD n'est pas juste, il manque la catégorie Ch.

Sans doute parce qu'en 2024.. il n'y a pas de Ch..

sinon, pour ta listbox
il te reste plus qu'à parcourir toutes les lignes, et si elles rentrent dans le/les critères, souhaités.. elles sont ajoutées à la listbox

 

[cathodique]

Sans doute parce qu'en 2024.. il n'y a pas de Ch..

sinon, pour ta listbox
il te reste plus qu'à parcourir toutes les lignes, et si elles rentrent dans le/les critères, souhaités.. elles sont ajoutées à la listbox

je t'avoue que je suis un peu (non beaucoup) perdu. Sinon, j'aurai monté le tableau pour alimenter la listbox.
Si ce n'était que les catégories à prendre en compte (colonne c). il y aussi le 2 autres colonnes (caractere et dateDC).
J'y arriverai mais pour le moment, ça bloque. Il ne s'agit pas uniquement de parcourir les lignes et prendre celles qui répondent aux critères. Il s'agit aussi de compter pour chaque année et pour chaque espèce, le nombre de Cd, Fa, Ad, Ch, Rt, adoptable, non adoptable, et enfin le nombre de décès.

En tout cas merci beaucoup.

 

[patricktoulon]

Bonjour @cathodique
bonnet bl"anc blanc bonnet
on prend les même et on recommence
un dico"avec des clés et arrays
en avant c'est qu'un tango

Option Explicit
Dim tb

Function GetlisteCountProp()
    Dim i As Long, d As Object, y&, esP$, cd&, fa&, Ad&, Ch&, Rt, Adoptable&, Non_Adoptable&, Dc, k
    Set d = CreateObject("scripting.dictionary")
    tb = ThisWorkbook.Sheets("BD").Range("table").Value
    For i = 1 To UBound(tb)
        '//////////////////////////////////////////////////////////////////////////////////////////
        'selon les valeaur  dans les colonnes corespondante on met 1 ou 0 dans les variable du même non que le header
        y = Year(CDate(tb(i, 1)))
        esP = tb(i, 4)
        cd = Abs(tb(i, 3) = "Cd")
        fa = Abs(tb(i, 3) = "Fa")
        Ad = Abs(tb(i, 3) = "Ad")
        Ch = Abs(tb(i, 3) = "ch")
        Rt = Abs(tb(i, 3) = "Rt")
        Adoptable = Abs(tb(i, 5) = "Adoptable")
        Non_Adoptable = Abs(tb(i, 5) = "Non Adoptable")
        Dc = Abs(tb(i, 6) <> "")
        '//////////////////////////////////////////////////////////////////////////////////////////

        'Maintenant on va alimenter le dico selon si la clé année et bestiole existe ou pas
        If Not d.exists(y & "_" & esP) Then
            ' donc si il n'existe pas on ajoute un array avec les valeur précédemment obtenue
            d(y & "_" & esP) = Array(y, esP, cd, fa, Ad, Ch, Rt, Adoptable, Non_Adoptable, Dc)
        Else
            'sinon on reprend l'array de la clé
            'et on additionne les items de l'array avec les valeurs obtenue Dim arr
            Dim arr
            arr = d(y & "_" & esP)
            arr(2) = arr(2) + cd
            arr(3) = arr(3) + fa
            arr(4) = arr(4) + Ad
            arr(5) = arr(5) + Ch
            arr(6) = arr(6) + Rt
            arr(7) = arr(7) + Adoptable
            arr(8) = arr(8) + Non_Adoptable
            arr(9) = arr(9) + Dc
            d(y & "_" & esP) = arr
        End If
    Next
    'k = d.keys
    'MsgBox Join(d(k(1)), ";")
    '//////////////////////////////////////////////////////////////////////////////////////////
    ' voila maintenant on a un dictionnaire rempli avec   des clés et un array a chaque clé
    ' exemple
    ' clé = "2024_chien"
    'et les valeaurs de l'array = [2024;Chien;4;4;4;0;0;12;0;0]
    '
    'il nous reste plus a retranscrire tout ca dans une variable tableau
    i = 0
    Dim xr, c&
    ReDim tbl(d.Count, 9) 'on dimentionne une variable tableau comme le dictionnaire avec 9 colonnes(EN BASE 0!!!!)
    For Each k In d.keys
        xr = d(k)
        For c = 0 To UBound(xr)
            tbl(i, c) = xr(c)
        Next
        i = i + 1
    Next
    GetlisteCountProp = tbl 'la fonction retourn le tableau
End Function

et pour la listbox dans le userform

Option Explicit
Dim tb, da As Object

Private Sub UserForm_Activate()
ListTitre.Column = Array("Année", "Espèce", "Cd", "Fa", "Ch", "Rt", "Adoptable", "Non Adoptable", "Décès")
ListTitre.ColumnCount = 9
ListTitre.ColumnWidths = "50;50;50;50;50;50;50;60;50"
ListCompt.ColumnCount = 9
ListCompt.ColumnWidths = "50;50;50;50;50;50;50;60;50"
ListCompt.List = GetlisteCountProp
End Sub

pas compliqué
si besoins
il te sera facile

de faire un filtre pour les( chiens ,chat ,tortue et poisson rouge )sur cette variable tableau je crois non ?

je reviens plus tard je m'en vais causer à la marmotte je trouve quelle lambine un peu avec le papier alu

 

[cathodique]

Bonjour @cathodique
bonnet bl"anc blanc bonnet
on prend les même et on recommence
un dico"avec des clés et arrays
en avant c'est qu'un tango

Option Explicit
Dim tb

Function GetlisteCountProp()
    Dim i As Long, d As Object, y&, esP$, cd&, fa&, Ad&, Ch&, Rt, Adoptable&, Non_Adoptable&, Dc, k
    Set d = CreateObject("scripting.dictionary")
    tb = ThisWorkbook.Sheets("BD").Range("table").Value
    For i = 1 To UBound(tb)
        '//////////////////////////////////////////////////////////////////////////////////////////
        'selon les valeaur  dans les colonnes corespondante on met 1 ou 0 dans les variable du même non que le header
        y = Year(CDate(tb(i, 1)))
        esP = tb(i, 4)
        cd = Abs(tb(i, 3) = "Cd")
        fa = Abs(tb(i, 3) = "Fa")
        Ad = Abs(tb(i, 3) = "Ad")
        Ch = Abs(tb(i, 3) = "ch")
        Rt = Abs(tb(i, 3) = "Rt")
        Adoptable = Abs(tb(i, 5) = "Adoptable")
        Non_Adoptable = Abs(tb(i, 5) = "Non Adoptable")
        Dc = Abs(tb(i, 6) <> "")
        '//////////////////////////////////////////////////////////////////////////////////////////

        'Maintenant on va alimenter le dico selon si la clé année et bestiole existe ou pas
        If Not d.exists(y & "_" & esP) Then
            ' donc si il n'existe pas on ajoute un array avec les valeur précédemment obtenue
            d(y & "_" & esP) = Array(y, esP, cd, fa, Ad, Ch, Rt, Adoptable, Non_Adoptable, Dc)
        Else
            'sinon on reprend l'array de la clé
            'et on additionne les items de l'array avec les valeurs obtenue Dim arr
            Dim arr
            arr = d(y & "_" & esP)
            arr(2) = arr(2) + cd
            arr(3) = arr(3) + fa
            arr(4) = arr(4) + Ad
            arr(5) = arr(5) + Ch
            arr(6) = arr(6) + Rt
            arr(7) = arr(7) + Adoptable
            arr(8) = arr(8) + Non_Adoptable
            arr(9) = arr(9) + Dc
            d(y & "_" & esP) = arr
        End If
    Next
    'k = d.keys
    'MsgBox Join(d(k(1)), ";")
    '//////////////////////////////////////////////////////////////////////////////////////////
    ' voila maintenant on a un dictionnaire rempli avec   des clés et un array a chaque clé
    ' exemple
    ' clé = "2024_chien"
    'et les valeaurs de l'array = [2024;Chien;4;4;4;0;0;12;0;0]
    '
    'il nous reste plus a retranscrire tout ca dans une variable tableau
    i = 0
    Dim xr, c&
    ReDim tbl(d.Count, 9) 'on dimentionne une variable tableau comme le dictionnaire avec 9 colonnes(EN BASE 0!!!!)
    For Each k In d.keys
        xr = d(k)
        For c = 0 To UBound(xr)
            tbl(i, c) = xr(c)
        Next
        i = i + 1
    Next
    GetlisteCountProp = tbl 'la fonction retourn le tableau
End Function

et pour la listbox dans le userform

Option Explicit
Dim tb, da As Object

Private Sub UserForm_Activate()
ListTitre.Column = Array("Année", "Espèce", "Cd", "Fa", "Ch", "Rt", "Adoptable", "Non Adoptable", "Décès")
ListTitre.ColumnCount = 9
ListTitre.ColumnWidths = "50;50;50;50;50;50;50;60;50"
ListCompt.ColumnCount = 9
ListCompt.ColumnWidths = "50;50;50;50;50;50;50;60;50"
ListCompt.List = GetlisteCountProp
End Sub

pas compliqué
si besoins
il te sera facileRegarde la pièce jointe 1202457 de faire un filtre pour les( chiens ,chat ,tortue et poisson rouge )sur cette variable tableau je crois non ?

je reviens plus tard je m'en vais causer à la marmotte je trouve quelle lambine un peu avec le papier alu

Bonsoir @patricktoulon ,

Je t'avoue que je suis bloqué. J'ai en effet tenté d'adapter ton précédent code mais je me suis noyé.

Je constate que tu as réussi à faire quelque chose.

Bien que bigleux, j'ai réussi à capter qu'il y a des erreurs rien qu'à voir la colonne Décès.
Il n'y en a que seule, c'est un chat survenu en 2024.

J'ai pris ton code, testé sur mon fichier. Mais la majorité des résultats sont inexacts.

En tout cas je te remercie. je savais déjà que ça n'allait pas être une partie de plaisir pour moi.

Bonne soirée.

 

[dysorthographie]

Bonjour,

Sub affiche()
UserForm2.ListCompt.Column = LST
  UserForm2.Show
End Sub
Function LST()
Dim SQL As String

With CreateObject("Adodb.connection")
    .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=YES;"""
    SQL = "SELECT Années, Espece, sum(CD),sum(FA),sum(AD),sum(CH),Sum(RT),Sum(adoptable),Sum(NAdoptable),Sum(DateDc) FROM (" & vbCrLf
    SQL = SQL & "SELECT DISTINCT NoDossier, FORMAT([Date],'yyyy') AS Années, [Espece], 1 AS CD, 0 AS FA,0 as AD,0 as CH,0 as RT,0 as adoptable,0 as NAdoptable,0 as DateDc FROM [BD$] WHERE UCASE([Cat#]) = 'CD'" & vbCrLf
    SQL = SQL & "UNION ALL" & vbCrLf
    SQL = SQL & "SELECT DISTINCT NoDossier, FORMAT([Date],'yyyy') AS Années, [Espece], 0 AS CD, 1 AS FA ,0 as AD,0 as CH,0 as RT,0 as adoptable,0 as NAdoptable,0 as DateDc FROM [BD$] WHERE UCASE([Cat#]) = 'FA'" & vbCrLf
    SQL = SQL & "UNION ALL" & vbCrLf
    SQL = SQL & "SELECT DISTINCT NoDossier, FORMAT([Date],'yyyy') AS Années, [Espece], 0 AS CD, 0 AS FA,1 as AD,0 as CH,0 as RT,0 as adoptable,0 as NAdoptable,0 as DateDc FROM [BD$] WHERE UCASE([Cat#]) = 'AD'" & vbCrLf
    SQL = SQL & "UNION ALL" & vbCrLf
    SQL = SQL & "SELECT DISTINCT NoDossier, FORMAT([Date],'yyyy') AS Années, [Espece], 0 AS CD, 0 AS FA,0 as AD,1 as CH,0 as RT,0 as adoptable,0 as NAdoptable,0 as DateDc FROM [BD$] WHERE UCASE([Cat#]) = 'CH'" & vbCrLf
    SQL = SQL & "UNION ALL" & vbCrLf
    SQL = SQL & "SELECT DISTINCT NoDossier, FORMAT([Date],'yyyy') AS Années, [Espece], 0 AS CD, 0 AS FA,0 as AD,0 as CH,1 as RT ,0 as adoptable,0 as NAdoptable,0 as DateDc FROM [BD$] WHERE UCASE([Cat#]) = 'RT'" & vbCrLf
    SQL = SQL & "UNION ALL" & vbCrLf
    SQL = SQL & "SELECT DISTINCT NoDossier, FORMAT([Date],'yyyy') AS Années, [Espece], 0 AS CD, 0 AS FA,0 as AD,0 as CH,0 as RT,1 as adoptable,0 as NAdoptable,0 as DateDc FROM [BD$] WHERE UCASE([Caractere]) = UCASE('Adoptable')" & vbCrLf
    SQL = SQL & "UNION ALL" & vbCrLf
    SQL = SQL & "SELECT DISTINCT NoDossier, FORMAT([Date],'yyyy') AS Années, [Espece], 0 AS CD, 0 AS FA,0 as AD,0 as CH,0 as RT,0 as adoptable,1 as NAdoptable,0 as DateDc FROM [BD$] WHERE UCASE([Caractere]) = UCASE('Non Adoptable')" & vbCrLf
    SQL = SQL & "UNION ALL" & vbCrLf
    SQL = SQL & "SELECT DISTINCT NoDossier, FORMAT([Date],'yyyy') AS Années, [Espece], 0 AS CD, 0 AS FA,0 as AD,0 as CH,0 as RT,0 as adoptable, 0 As NAdoptable,1 as DateDc FROM [BD$] WHERE [DateDc]  is not null" & vbCrLf
    SQL = SQL & ") AS SubQuery GROUP BY Années, Espece"
  

   LST = .Execute(SQL).getrows
End With
End Function

 

[patricktoulon]

re
en fait c’était bon il manquait la colone "Ad" dans la listbox
tu m’étonne que ça matchait pas
si on ajoute la colonne "Ad" ca match
maintenant si tu veux l'enlever tu le dit

Option Explicit

Function GetlisteCountProp()
    'patricktoulon
    'Version 2
    Dim i As Long, d As Object, k, tb
    Dim y&, esP$, Cd&, Fa&, Ad&, Ch&, Rt&, Adoptable&, Non_Adoptable&, Dc&
    Set d = CreateObject("scripting.dictionary")
    tb = ThisWorkbook.Sheets("BD").Range("table").Value
    For i = 1 To UBound(tb)
        '//////////////////////////////////////////////////////////////////////////////////////////
        'selon les valeaur  dans les colonnes corespondante on met 1 ou 0 dans les variable du même non que le header
        y = Year(tb(i, 1))
        esP = Trim(tb(i, 4))
        Cd = Abs(Trim(tb(i, 3)) = "Cd")
        Fa = Abs(Trim(tb(i, 3)) = "Fa")
        Ad = Abs(Trim(tb(i, 3)) = "Ad")
        Ch = Abs(Trim(tb(i, 3)) = "Ch")
        Rt = Abs(Trim(tb(i, 3)) = "Rt")
        Adoptable = Abs(Trim(tb(i, 5)) = "Adoptable")
        Non_Adoptable = Abs(Trim(tb(i, 5)) = "Non Adoptable")
        Dc = Abs(Trim(tb(i, 6)) <> "")
        'MsgBox Join(Array(y, esP, cd, fa, Ad, Ch, Rt, Adoptable, Non_Adoptable, Dc))
        '//////////////////////////////////////////////////////////////////////////////////////////

        'Maintenant on va alimenter le dico selon si la clé année et bestiole existe ou pas
        If Not d.exists(y & "_" & esP) Then
            ' donc si il n'existe pas on ajoute un array avec les valeur précédemment obtenue
            d(y & "_" & esP) = Array(y, esP, Cd, Fa, Ad, Ch, Rt, Adoptable, Non_Adoptable, Dc)
        Else
            'sinon on reprend l'array de la clé
            'et on additionne les items de l'array avec les valeurs obtenue Dim arr
            Dim arr
            arr = d(y & "_" & esP)
            arr(2) = arr(2) + Cd
            arr(3) = arr(3) + Fa
            arr(4) = arr(4) + Ad
            arr(5) = arr(5) + Ch
            arr(6) = arr(6) + Rt
            arr(7) = arr(7) + Adoptable
            arr(8) = arr(8) + Non_Adoptable
            arr(9) = arr(9) + Dc
            d(y & "_" & esP) = arr
        End If
    Next
    'k = d.keys
    'MsgBox Join(d(k(1)), ";")
    '//////////////////////////////////////////////////////////////////////////////////////////
    ' voila maintenant on a un dictionnaire rempli avec   des clés et un array a chaque clé
    ' exemple
    ' clé = "2024_chien"
    'et les valeaurs de l'array = [2024;Chien;4;4;4;0;0;12;0;0]
    '
    'il nous reste plus a retranscrire tout ca dans une variable tableau
    i = 0
    Dim xr, c&
    ReDim tbl(d.Count, 9) 'on dimentionne une variable tableau comme le dictionnaire avec 9 colonnes(EN BASE 0!!!!)
    For Each k In d.keys
        xr = d(k)
        For c = 0 To UBound(xr)
            tbl(i, c) = xr(c)
        Next
        i = i + 1
    Next
    GetlisteCountProp = tbl 'la fonction retourn le tableau
End Function

userform

Option Explicit

Private Sub UserForm_Activate()
ListTitre.Column = Array("Année", "Espèce", "Cd", "Fa", "Ad", "Ch", "Rt", "Adoptable", "Non Adoptable", "Décès")
ListTitre.ColumnCount = 11
ListTitre.ColumnWidths = "50;50;50;50;50;50;50;60;50;50"
ListCompt.ColumnCount = 11
ListCompt.ColumnWidths = "50;50;50;50;50;50;50;60;50;50"
ListCompt.List = GetlisteCountProp
End Sub

pour le filtre année tu t'en sortira pou pas ?

 

[cathodique]

Bonjour,

Sub affiche()
UserForm2.ListCompt.Column = LST
  UserForm2.Show
End Sub
Function LST()
Dim SQL As String

With CreateObject("Adodb.connection")
    .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=YES;"""
    SQL = "SELECT Années, Espece, sum(CD),sum(FA),sum(AD),sum(CH),Sum(RT),Sum(adoptable),Sum(NAdoptable),Sum(DateDc) FROM (" & vbCrLf
    SQL = SQL & "SELECT DISTINCT NoDossier, FORMAT([Date],'yyyy') AS Années, [Espece], 1 AS CD, 0 AS FA,0 as AD,0 as CH,0 as RT,0 as adoptable,0 as NAdoptable,0 as DateDc FROM [BD$] WHERE UCASE([Cat#]) = 'CD'" & vbCrLf
    SQL = SQL & "UNION ALL" & vbCrLf
    SQL = SQL & "SELECT DISTINCT NoDossier, FORMAT([Date],'yyyy') AS Années, [Espece], 0 AS CD, 1 AS FA ,0 as AD,0 as CH,0 as RT,0 as adoptable,0 as NAdoptable,0 as DateDc FROM [BD$] WHERE UCASE([Cat#]) = 'FA'" & vbCrLf
    SQL = SQL & "UNION ALL" & vbCrLf
    SQL = SQL & "SELECT DISTINCT NoDossier, FORMAT([Date],'yyyy') AS Années, [Espece], 0 AS CD, 0 AS FA,1 as AD,0 as CH,0 as RT,0 as adoptable,0 as NAdoptable,0 as DateDc FROM [BD$] WHERE UCASE([Cat#]) = 'AD'" & vbCrLf
    SQL = SQL & "UNION ALL" & vbCrLf
    SQL = SQL & "SELECT DISTINCT NoDossier, FORMAT([Date],'yyyy') AS Années, [Espece], 0 AS CD, 0 AS FA,0 as AD,1 as CH,0 as RT,0 as adoptable,0 as NAdoptable,0 as DateDc FROM [BD$] WHERE UCASE([Cat#]) = 'CH'" & vbCrLf
    SQL = SQL & "UNION ALL" & vbCrLf
    SQL = SQL & "SELECT DISTINCT NoDossier, FORMAT([Date],'yyyy') AS Années, [Espece], 0 AS CD, 0 AS FA,0 as AD,0 as CH,1 as RT ,0 as adoptable,0 as NAdoptable,0 as DateDc FROM [BD$] WHERE UCASE([Cat#]) = 'RT'" & vbCrLf
    SQL = SQL & "UNION ALL" & vbCrLf
    SQL = SQL & "SELECT DISTINCT NoDossier, FORMAT([Date],'yyyy') AS Années, [Espece], 0 AS CD, 0 AS FA,0 as AD,0 as CH,0 as RT,1 as adoptable,0 as NAdoptable,0 as DateDc FROM [BD$] WHERE UCASE([Caractere]) = UCASE('Adoptable')" & vbCrLf
    SQL = SQL & "UNION ALL" & vbCrLf
    SQL = SQL & "SELECT DISTINCT NoDossier, FORMAT([Date],'yyyy') AS Années, [Espece], 0 AS CD, 0 AS FA,0 as AD,0 as CH,0 as RT,0 as adoptable,1 as NAdoptable,0 as DateDc FROM [BD$] WHERE UCASE([Caractere]) = UCASE('Non Adoptable')" & vbCrLf
    SQL = SQL & "UNION ALL" & vbCrLf
    SQL = SQL & "SELECT DISTINCT NoDossier, FORMAT([Date],'yyyy') AS Années, [Espece], 0 AS CD, 0 AS FA,0 as AD,0 as CH,0 as RT,0 as adoptable, 0 As NAdoptable,1 as DateDc FROM [BD$] WHERE [DateDc]  is not null" & vbCrLf
    SQL = SQL & ") AS SubQuery GROUP BY Années, Espece"
 

   LST = .Execute(SQL).getrows
End With
End Function

Bonsoir @dysorthographie ,

je te remercie. C'est surement dû à mes explications tordues. C'est très rapide mais les bons résultats ne sont pas au RDV.
Ce qu'il y a dans mon fichier sont les bons résultats à obtenir. J'aurais souhaité avoir les années par ordre décroissant pour me faciliter les vérifications.
Je reviendrai pour te dire si les résultats obtenus avec ton code sont bons. Cependant, je peux te dire qu'il y a un seul décès enregistré sur les lignes d'entrée à l'association et sa mise en famille d'accueil le même jour en 2020. Il est comptabilisé en 2020 alors qu'il doit être comptabilisé en 2024.
Les résultats sont apparemment bons pour les différentes catégories (Cd, Fa, Ad, Ch, Rt).
Par contre, pour adoptable et non adoptable, il y a surement des doublons.

Merci beaucoup.

Bonne soirée.