XL 2010 tableau de comptage sans doublon

cathodique · Dimanche à 13:35

Bonjour,

N'étant pas parvenu à résoudre mon problème seul. Je sollicite une aide auprès de la communauté d'XLD.

Sur la feuille résultat vous trouverez 3 petits tableaux, le nombre de lignes est fonction du nombre d’espèces (col6).
Je les ai arrêté à 3 par rapport aux données actuelles de la bd, juste pour illustrer le problème.
Je voudrais travailler avec des variables tableaux parce que la bd aura un nombre très important de lignes. (les colonnes pourraient évoluer aussi).

L'objectif est de compter sans doublon selon des critères:
Critère1 sur les dates, 1er tableau jusqu'à fin de l'année N-1, 2ème tableau année en cours et le 2ème toutes les années.
Critère2 par rapport aux espèces, dans les tableaux résultats ils sont dans la colonne1 à partir de la 2ème ligne et se trouvent en colonne 6 de la bd. Ils faut compte pour chaque espèce selon les critères 3, qui se trouvent en ligne 1 à partir de la 2ème colonne des petits tableaux. les critères de 2 à 7 se trouvent dans la colonne 4 de la bd; de 8 à 9 dans la colonne 13 et la 10 dans la colonne 14.

Pour 8 à 9, le comptage se fait si dans la colonne 4 il y a "Fa"
Pour 10, le comptage se fait si l'année de la colonne 14 correspond à l'année de la colonne 1.

Dans une précédente discussion, @dysorthographie m'avait suggéré une approche dans le genre bataille navale pour récupérer les critères. Très bonne idée, mais je me suis emmêlé les pinceaux.

Je suis parvenu à mon monter mes petits tableaux par code (non joint pour le pas "polluer" le fichier).
Et, il se peut que mon approche était fausse dès le départ.

En espérant, avoir été clair.

Merci

cathodique · Hier à 19:03

klin89 à dit:

Re à tous,

Étant donné la question initiale de cathodique, les remarques pertinentes de job75, les tentatives avortées de Bernard et Staple1600, et les éclaircissements fournis par dysortographie,
ma réponse n'apportera probablement rien de nouveau et est finalement à côté de la plaque.
Mais comme j'ai bossé sur le sujet, je la poste tout de même, elle pourra peut-être être utile à d'autres.

VB:

Option Explicit
Sub test()
    Dim a, b, e, s, v, i As Long, n As Long, dico(1) As Object
    Dim LastYear As Long
    Set dico(0) = CreateObject("Scripting.Dictionary")
    Set dico(1) = CreateObject("Scripting.Dictionary")
    a = Sheets("BD").[a1].CurrentRegion.Value2
    LastYear = Year(Application.Max(Application.Index(a, 0, 1)))
    For Each e In Array(Array("<" & LastYear + 1, "Anterieur_" & LastYear + 1), Array("<" & LastYear, "Anterieur_" & LastYear), Array("=" & LastYear, "Annee_" & LastYear))
        For i = 2 To UBound(a, 1)
            If Evaluate("Year(" & a(i, 1) & ")" & e(0)) Then
                If Not dico(1).exists(a(i, 4)) Then dico(1)(a(i, 4)) = dico(1).Count + 2
                If Not dico(0).exists(a(i, 6)) Then
                    Set dico(0)(a(i, 6)) = CreateObject("Scripting.Dictionary")
                End If
                dico(0)(a(i, 6))(a(i, 4)) = dico(0)(a(i, 6))(a(i, 4)) + 1
            End If
        Next
        For i = 2 To UBound(a, 1)
            If Evaluate("Year(" & a(i, 1) & ")" & e(0)) Then
                If Not dico(1).exists(a(i, 13)) Then dico(1)(a(i, 13)) = dico(1).Count + 2
                If a(i, 4) = "Fa" Then
                    dico(0)(a(i, 6))(a(i, 13)) = dico(0)(a(i, 6))(a(i, 13)) + 1
                End If
            End If
        Next
        If Not dico(1).exists("Décès") Then dico(1)("Décès") = dico(1).Count + 2
        For i = 2 To UBound(a, 1)
            If Evaluate("Year(" & a(i, 1) & ")" & e(0)) Then
                If Not IsEmpty(a(i, 14)) Then
                    If Year(a(i, 14)) = Year(a(i, 1)) Then
                        dico(0)(a(i, 6))("Décès") = dico(0)(a(i, 6))("Décès") + 1
                    End If
                End If
            End If
        Next
        ReDim b(1 To dico(0).Count + 1, 1 To dico(1).Count + 1)
        n = 0
        For Each s In dico(0)
            n = n + 1: b(n, 1) = s
            For Each v In dico(0)(s)
                b(n, dico(1)(v)) = dico(0)(s)(v)
            Next
        Next
        Application.ScreenUpdating = False
        If Not Evaluate("isref('" & e(1) & "'!a1)") Then
            Sheets.Add(after:=Sheets(Sheets.Count)).Name = e(1)
        End If
        With Sheets(e(1)).[a1]
            .CurrentRegion.Clear
            .Value = "Espèces"
            .Range("b1").Resize(, dico(1).Count) = dico(1).keys
            .Range("a2").Resize(dico(0).Count, dico(1).Count + 1) = b
            With .CurrentRegion
                .Font.Name = "calibri"
                .Font.Size = 10
                .VerticalAlignment = xlCenter
                .Borders(xlInsideVertical).Weight = xlThin
                .BorderAround Weight:=xlThin
                With .Rows(1)
                    .HorizontalAlignment = xlCenter
                    .Font.Size = 11
                    .BorderAround Weight:=xlThin
                    .Interior.Color = 9420794
                End With
                .Columns.ColumnWidth = 14
            End With
        End With
        Erase b
        dico(0).RemoveAll: dico(1).RemoveAll
    Next
    Set dico(0) = Nothing: Set dico(1) = Nothing
    Application.ScreenUpdating = True
End Sub

Me reste à examiner l'analyse apportée par dysortographie et à en comprendre le cheminement
Pas simple quand même

klin89

Merci beaucoup.
Je m'excuse si je n'ai pas été à la hauteur pour exposer mon problème.
et désolé d'avoir peut-être causé des frustrations à certain.

dysorthographie · Hier à 20:20

a oui désolé j'ai inversé les colonne dan ma requête mais si tu remets en phase les entête de colonnes ?

	Espèce	Cd	Fa	Ad	ChFa	RtAd	Adoptable	Non Adoptable	A Déterminer	Décès
2010	Chat	0	1	0	0	0	0	0	0	0
2011	Chien	1	0	0	0	0	0	0	0	1
2015	Chat	0	1	1	0	0	0	0	0	0
2016	Chat	0	2	0	0	0	0	0	0	0
2017	Chat	0	2	1	0	0	0	0	0	1
2018	Chien	0	1	0	0	0	0	0	0	0
2019	Chat	0	6	0	2	0	0	0	0	0
2020	Chat	0	5	0	0	0	0	0	0	1
2021	Chat	2	10	0	2	0	0	0	0	0
2021	Chien	0	1	0	0	0	0	0	0	0
2022	Chat	0	8	0	0	0	0	0	0	0
2023	Chat	11	24	0	3	0	0	0	0	0
2023	Chien	0	4	0	0	0	0	0	0	0
2023	Lapin	0	1	0	0	0	0	0	0	0
2024	Chat	0	28	34	0	0	0	0	2	0
2024	Chien	0	2	4	0	0	0	0	0	0
2024	Lapin	0	0	1	0	0	0	0	0	0

cathodique · Hier à 23:11

dysorthographie à dit:
a oui désolé j'ai inversé les colonne dan ma requête mais si tu remets en phase les entête de colonnes ?

Espèce Cd Fa Ad ChFa RtAd Adoptable Non Adoptable A Déterminer Décès
2010
Chat
0
1
0
0
0
0
0
0
0
2011
Chien
1
0
0
0
0
0
0
0
1
2015
Chat
0
1
1
0
0
0
0
0
0
2016
Chat
0
2
0
0
0
0
0
0
0
2017
Chat
0
2
1
0
0
0
0
0
1
2018
Chien
0
1
0
0
0
0
0
0
0
2019
Chat
0
6
0
2
0
0
0
0
0
2020
Chat
0
5
0
0
0
0
0
0
1
2021
Chat
2
10
0
2
0
0
0
0
0
2021
Chien
0
1
0
0
0
0
0
0
0
2022
Chat
0
8
0
0
0
0
0
0
0
2023
Chat
11
24
0
3
0
0
0
0
0
2023
Chien
0
4
0
0
0
0
0
0
0
2023
Lapin
0
1
0
0
0
0
0
0
0
2024
Chat
0
28
34
0
0
0
0
2
0
2024
Chien
0
2
4
0
0
0
0
0
0
2024
Lapin
0
0
1
0
0
0
0
0
0

Je te remercie mais ce n'est pas du tout ça. Ci-dessous résultat

2 chats décès et 1 chien doivent apparaitre pour 2024, car les décès sont survenus en 2024.
En espérant que tu me comprennes. Encore merci.

Bonne soirée.

dysorthographie · Hier à 23:25

Ok merci pour la précision ça me tardait de voir 2024 pour la date de décès sur l'année 2019 d'où le surlignage des résultats.

	Espèce	Cd	Fa	Ad	ChFa	RtAd	Adoptable	Non Adoptable	A Déterminer	Décès
2010	Chat	0	1	0	0	0	0	0	0	0
2011	Chien	1	0	0	0	0	0	0	0	0
2015	Chat	0	1	1	0	0	0	0	0	0
2016	Chat	0	2	0	0	0	0	0	0	0
2017	Chat	0	2	1	0	0	0	0	0	0
2018	Chien	0	1	0	0	0	0	0	0	0
2019	Chat	0	6	0	2	0	0	0	0	0
2020	Chat	0	5	0	0	0	0	0	0	0
2021	Chat	2	10	0	2	0	0	0	0	0
2021	Chien	0	1	0	0	0	0	0	0	0
2022	Chat	0	8	0	0	0	0	0	0	0
2023	Chat	11	24	0	3	0	0	0	0	0
2023	Chien	0	4	0	0	0	0	0	0	0
2023	Lapin	0	1	0	0	0	0	0	0	0
2024	Chat	0	28	34	0	0	0	0	2	2
2024	Chien	0	2	4	0	0	0	0	0	1
2024	Lapin	0	0	1	0	0	0	0	0	0

cathodique · Hier à 23:58

dysorthographie à dit:
Ok merci pour la précision ça me tardait de voir 2024 pour la date de décès sur l'année 2019 d'où le surlignage des résultats.

Espèce Cd Fa Ad ChFa RtAd Adoptable Non Adoptable A Déterminer Décès
2010
Chat
0
1
0
0
0
0
0
0
0
2011
Chien
1
0
0
0
0
0
0
0
0
2015
Chat
0
1
1
0
0
0
0
0
0
2016
Chat
0
2
0
0
0
0
0
0
0
2017
Chat
0
2
1
0
0
0
0
0
0
2018
Chien
0
1
0
0
0
0
0
0
0
2019
Chat
0
6
0
2
0
0
0
0
0
2020
Chat
0
5
0
0
0
0
0
0
0
2021
Chat
2
10
0
2
0
0
0
0
0
2021
Chien
0
1
0
0
0
0
0
0
0
2022
Chat
0
8
0
0
0
0
0
0
0
2023
Chat
11
24
0
3
0
0
0
0
0
2023
Chien
0
4
0
0
0
0
0
0
0
2023
Lapin
0
1
0
0
0
0
0
0
0
2024
Chat
0
28
34
0
0
0
0
2
2
2024
Chien
0
2
4
0
0
0
0
0
1
2024
Lapin
0
0
1
0
0
0
0
0
0

Ok, merci, mais les autres résultats ne sont pas corrects à l'exception de quelques uns.
Je suppose que je n'ai pas été très clair. Je ne sais pas si tu soustrais ou ne compte dans la catégorie Cd.
On compte cette catégorie et on n'y touche plus. La gestion des mouvements se fait au travers des autres catégories (Fa, Ad, ChFa et RtAd).

dysorthographie · Aujourd'hui à 01:32

reposte le tableaux corrigé avec tes commentaire et je devrai trouvé les bonnes correction

On compte les cd tél qu'il ce présente car il ne peuvent pas être en double ?

Pour les autres qui correspondent à des mouvements on prend le dernier mouvement?

pourrais tu également préciser sur quel critère Etat des Animaux encore présents en Fin d'Année 2024.

ne te flagelle pas, ton propos est complexe et à expliquer et à comprendre mais je pense qu'on est en bon voie!

De toutes le façon je me vengerai au moment des explications car un usine à gaz en SQL ce ce digérer pas facilement.

VB:

Sub test2()
Dim SqlTOutSdoublon As String, SqlTOutTOut As String, Sql
 SqlTOutSdoublon = "(SELECT  year([Date]) as Annee,NoDossier,last([Cat#]) as Cat,last(Espece) as Espece,last(Caractère) as Caractère,max(DateDC) as DateDC FROM [BD$] group by NoDossier, year([Date]))"

With CreateObject("Adodb.connection")
    .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=YES;"""
    SqlTOut = "SELECT Annee, Espece, sum(CD) as CD,sum(FA) as FA,sum(AD) as AD,sum(ChFa) as ChFa,Sum(RtAd) as RtAd,Sum(adoptable) as adoptable,Sum(NAdoptable) as NAdoptable,sum([A Déterminer]) as [A Déterminer],Sum(DateDc) as DateDc FROM (" & vbCrLf
    SqlTOut = SqlTOut & "SELECT DISTINCT NoDossier, Annee, [Espece], 1 AS CD, 0 AS FA,0 as AD,0 as ChFa,0 as RtAd,0 as adoptable,0 as NAdoptable,0 AS [A Déterminer],0 as DateDc FROM " & SqlTOutSdoublon & " WHERE UCASE([Cat]) = 'CD'" & vbCrLf
    SqlTOut = SqlTOut & "UNION ALL" & vbCrLf
    SqlTOut = SqlTOut & "SELECT DISTINCT NoDossier, Annee, [Espece], 0 AS CD, 1 AS FA ,0 as AD,0 as ChFa,0 as RtAd,0 as adoptable,0 as NAdoptable,0 AS [A Déterminer],0 as DateDc FROM " & SqlTOutSdoublon & " WHERE UCASE([Cat]) = 'FA'" & vbCrLf
    SqlTOut = SqlTOut & "UNION ALL" & vbCrLf
    SqlTOut = SqlTOut & "SELECT DISTINCT NoDossier, Annee, [Espece], 0 AS CD, 0 AS FA,1 as AD,0 as ChFa,0 as RtAd,0 as adoptable,0 as NAdoptable,0 AS [A Déterminer],0 as DateDc FROM " & SqlTOutSdoublon & " WHERE UCASE([Cat]) = 'AD'" & vbCrLf
    SqlTOut = SqlTOut & "UNION ALL" & vbCrLf
    SqlTOut = SqlTOut & "SELECT DISTINCT NoDossier, Annee, [Espece], 0 AS CD, 0 AS FA,0 as AD,1 as ChFa,0 as RtAd,0 as adoptable,0 as NAdoptable,0 AS [A Déterminer],0 as DateDc FROM " & SqlTOutSdoublon & " WHERE UCASE([Cat]) = 'CHFA'" & vbCrLf
    SqlTOut = SqlTOut & "UNION ALL" & vbCrLf
    SqlTOut = SqlTOut & "SELECT DISTINCT NoDossier, Annee, [Espece], 0 AS CD, 0 AS FA,0 as AD,0 as ChFa,1 as RtAd ,0 as adoptable,0 as NAdoptable,0 AS [A Déterminer],0 as DateDc FROM " & SqlTOutSdoublon & " WHERE UCASE([Cat]) = 'RTAD'" & vbCrLf
    SqlTOut = SqlTOut & "UNION ALL" & vbCrLf
     SqlTOut = SqlTOut & "SELECT DISTINCT NoDossier, Annee, [Espece], 0 AS CD, 0 AS FA,0 as AD,0 as ChFa,0 as RtAd ,1 as adoptable,0 as NAdoptable,0 AS [A Déterminer],0 as DateDc FROM " & SqlTOutSdoublon & " WHERE UCASE([Cat]) = 'ADOPTABLE'" & vbCrLf
     SqlTOut = SqlTOut & "UNION ALL" & vbCrLf
     SqlTOut = SqlTOut & "SELECT DISTINCT NoDossier, Annee, [Espece], 0 AS CD, 0 AS FA,0 as AD,0 as ChFa,0 as RtAd ,0 as adoptable,1 as NAdoptable,0 AS [A Déterminer],0 as DateDc FROM " & SqlTOutSdoublon & " WHERE UCASE([Cat]) = 'NON ADOPTABLE'" & vbCrLf
     SqlTOut = SqlTOut & "UNION ALL" & vbCrLf
     SqlTOut = SqlTOut & "SELECT DISTINCT NoDossier,year(DateDc) as  Annee, [Espece], 0 AS CD, 0 AS FA,0 as AD,0 as ChFa,0 as RtAd ,0 as adoptable,0 as NAdoptable,0 AS [A Déterminer],1 as DateDc FROM " & SqlTOutSdoublon & " WHERE[DateDc]  is not null" & vbCrLf
     SqlTOut = SqlTOut & "UNION ALL" & vbCrLf
     SqlTOut = SqlTOut & "SELECT DISTINCT NoDossier, Annee, [Espece], 0 AS CD, 0 AS FA,0 as AD,0 as ChFa,0 as RtAd ,0 as adoptable,0 as NAdoptable,1 AS [A Déterminer],0 as DateDc FROM " & SqlTOutSdoublon & " WHERE UCASE([Caractère]) = ucase('A Déterminer')" & vbCrLf
      SqlTOut = SqlTOut & "UNION ALL" & vbCrLf
     SqlTOut = SqlTOut & "SELECT DISTINCT  NoDossier, Year([BD$].[Date]) AS Annee, Especes.Espece,CD,FA,AD,ChFa,RtAd,adoptable,NAdoptable,[A Déterminer],DateDc   FROM [BD$] , (SELECT DISTINCT Espece, 0 AS CD, 0 AS FA, 0 AS AD, 0 AS ChFa, 0 AS RtAd, 0 AS adoptable, 0 AS NAdoptable, 0 AS [A Déterminer], 0 AS DateDc FROM [BD$]) AS Especes" & vbCrLf
     SqlTOut = SqlTOut & ") AS SubQuery GROUP BY Annee, Espece"

'2023
 Sql = "SELECT  Espece, sum(CD) as CD,sum(FA) as FA,sum(AD) as AD,sum(ChFa) as ChFa,Sum(RtAd) as RtAd,Sum(adoptable) as adoptable,Sum(NAdoptable) as NAdoptable,sum([A Déterminer]) as [A Déterminer],Sum(DateDc) as DateDc FROM (" & vbCrLf
 Sql = Sql & SqlTOut
 Sql = Sql & ") AS SubQuery WHERE Annee=" & Year(Date) - 1 & "  GROUP BY  Espece"
   Sheets("Résultat").Range("B7").CopyFromRecordset .Execute(Sql)
 
'2024
 Sql = "SELECT  Espece, sum(CD) as CD,sum(FA) as FA,sum(AD) as AD,sum(ChFa) as ChFa,Sum(RtAd) as RtAd,Sum(adoptable) as adoptable,Sum(NAdoptable) as NAdoptable,sum([A Déterminer]) as [A Déterminer],Sum(DateDc) as DateDc FROM (" & vbCrLf
 Sql = Sql & SqlTOut
 Sql = Sql & ") AS SubQuery WHERE Annee=" & Year(Date) & "  GROUP BY  Espece"
   Sheets("Résultat").Range("B13").CopyFromRecordset .Execute(Sql)
End With

End Sub

XL 2010 tableau de comptage sans doublon

cathodique

XLDnaute Barbatruc

cathodique

XLDnaute Barbatruc

dysorthographie

XLDnaute Accro

cathodique

XLDnaute Barbatruc

dysorthographie

XLDnaute Accro

cathodique

XLDnaute Barbatruc

dysorthographie

XLDnaute Accro

Discussions similaires