Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2010 Comptage Complexe

cathodique

XLDnaute Barbatruc
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.

VB: 
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.
 

Pièces jointes

  • Comptage - Copie.xlsm
    44.3 KB · Affichages: 21
Trier par date Trier par votes

mapomme

XLDnaute Barbatruc
Supporter XLD
cathodique à dit:
Attention, pour caractere, ils sont en doublons car chaque NoDossier peut changer de cat. au fil du temps.
Cliquez pour agrandir...
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 .
 
Vote positif 0 Vote négatif

cathodique

XLDnaute Barbatruc
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.
 
Vote positif 0 Vote négatif

cathodique

XLDnaute Barbatruc
vgendron à dit:
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
Cliquez pour agrandir...
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.
 
Vote positif 0 Vote négatif

patricktoulon

XLDnaute Barbatruc
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

VB: 
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
VB: 
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
 
Vote positif 0 Vote négatif

cathodique

XLDnaute Barbatruc
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.
 
Vote positif 0 Vote négatif

dysorthographie

XLDnaute Accro
Bonjour,
Code: 
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
 
Dernière édition:
Vote positif 0 Vote négatif

patricktoulon

XLDnaute Barbatruc
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
VB: 
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
VB: 
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 ?
 

Pièces jointes

  • Comptage - Copie.xlsm
    39.3 KB · Affichages: 3
Vote positif 0 Vote négatif

cathodique

XLDnaute Barbatruc
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.
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

  • Question
XL 2010 classer clé dico dans un ordre prédéfini
2
Réponses
25
Affichages
1 K
job75
  • Question
XL 2010 Code de l'IA à corriger
2 3
Réponses
33
Affichages
2 K
cathodique
  • Résolu(e)
XL 2010 Mauvaise utilisation de la fonction InStr
Réponses
11
Affichages
592
jurassic pork
  • Question
XL 2010 Comment lire array dans item dictionnaire
2 3
Réponses
33
Affichages
2 K
cathodique
D
  • Question
XL 2010 Recherche cellule vide sur une ligne
Réponses
9
Affichages
254
job75
O
  • Question
Autres Optimisation macro numérotation ligne
Réponses
11
Affichages
191
crocrocro
C
M
  • Résolu(e)
XL 2021 PUBLIPOSTAGE : Mise en forme du corps de message issu d'une cellule excel (VBA)
Réponses
4
Affichages
328
Minus&Cortex
M
N
  • Résolu(e)
Microsoft 365 Mettre la 4ème colonne d'une ListBox au format [h]:mm
3 4 5
Réponses
68
Affichages
1 K
NONO14
N
  • Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
923
Nicolas JACQUIN
  • Question
XL 2019 Fusionner jusqu'à dernière colonne contenant
Réponses
8
Affichages
591
TooFatBoy
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…