Données manquantes par rapport 2 dates (Dictionary)

[cathodique]

Bonjour,

Je me tourne vers la communauté, sollicitant votre aide. En effet, je n'ai pas d'idée pour trouver une bonne approche du problème.

Voici le topo de mon travail. Via Userform, je reconstitue sur la feuille "menu", un canevas extrait de la feuille "BD_Ref". L'extraction du canevas est basée sur 3 données [Type, Famille et Sous-Famille]

Je le complète avec une date, un procédé de Test , des mesures et je le transfert par macro dans la feuille "BD_Test".

Les procédés de test sont de 4 (col R, feuille BD_Test), seuls les procédés M/A et M seront pris en compte dans la procédure.

je voudrais qu'un message me signale les données manquantes dans la BD_Test.

En effet, pour chaque combinaison [Famille|Sous-Famille] de BD_Ref doit être présente dans BD_Test avec une date et un procédé (test) .

Je voudrais donc trouver les combinaisons qu'on retrouve pas sur la feuille BD_Test avec une date . Mais il faut aussi tenir compte de l'année d'acquisition des familles.

En effet, il peut pas y avoir dans BD_Test des données antérieures à la date d'acquisition.

Les données de références étant répétées, j'ai commencé par utiliser 2 dictionnaires, mais pour la suite je ne sais pas quelle serait la meilleure approche pour trouver une solution assez rapide, vu que le nombre de lignes est assez conséquent.

Sur la feuille recap, vous trouverez le résultat à obtenir. Il y aussi un tableau des dates d'acquisition.

Au final, c'est d'avoir un message m'indique BD_Test "à jour" ou un listing [date, famille, sous-famille] manquantes,

En espérant avoir été clair, je vous remercie par avance.

ps: la sous-famille: M1 n'est pas prise en compte dans le dictionnaire DicRef (sous-famille cédée mais existe dans BD_Test)

 

[Bebere]

Re : Données manquantes par rapport 2 dates

bonjour cathodique,le forum
regarde si cela répond à ton attente,résultats en L17,M17

Sub retrouver_valeurs() Dim Ltest As Integer, Lref As Integer, i As Integer, j As Long, c As Long, ii As Long
Dim Tbtest(), Tbref(), TbR, TbT, Tbtest2()
Dim DicTest As Object, DicRef As Object, d As Object
Dim tblDate, a, b(), cle
tblDate = Feuil4.[K2:L9]
With Sheets("BD_Ref")
Lref = .Range("A" & Rows.Count).End(xlUp).Row
Tbref = .Range("c2:d" & Lref).Value
Set DicRef = CreateObject("Scripting.Dictionary")
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Tbref)
If Tbref(i, 2) <> "M1" Then 'on ne prend pas la famille M1
DicRef(Tbref(i, 1) & Tbref(i, 2)) = ""
End If


Next i


End With


With Sheets("BD_Test")
Ltest = .Range("A" & Rows.Count).End(xlUp).Row
Tbtest = .Range("A2:R" & Ltest).Value


Set DicTest = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(tblDate)
c = 0
For j = 1 To UBound(Tbtest)
d(Tbtest(j, 4)) = ""
If Tbtest(j, 18) = "M" Or Tbtest(j, 18) = "M/A" Then '**on ne prend que pour Test= M ou M/A
If Tbtest(j, 3) <= tblDate(i, 2) Then
'cle=famille&sous-famille -----> item= date test
' If Not DicTest.Exists(Tbtest(j, 4) & Tbtest(j, 5)) Then DicTest.Add Tbtest(j, 4) & Tbtest(j, 5), Tbtest(j, 3)
DicTest(Tbtest(j, 4) & " - " & Tbtest(j, 5) & " - " & Tbtest(j, 3)) = ""
End If
End If




Next j
Next i
For Each cle In d.keys
c = 0
For j = 1 To UBound(tblDate)
If tblDate(j, 1) = cle Then c = c + 1: Exit For
Next j


If c = 0 Then
ii = ii + 1
ReDim Preserve b(1 To 1, 1 To ii): b(1, ii) = cle
End If
Next cle
End With


a = DicTest.keys
b = Application.Transpose(b)
Feuil4.[L17].Resize(DicTest.Count) = Application.Transpose(a)
If d.Count > 0 Then
Feuil4.[N17].Resize(UBound(b, 1), UBound(b, 2)) = b
End If


End Sub

 

[cathodique]

Re : Données manquantes par rapport 2 dates

Bonjour Bebere,

Je te remercie beaucoup de m'avoir proposé un code, c'est très gentil de ta part. J'avoue que depuis 2 jours je consulte les exemples de Boisgontier pour essayer de trouver une solution. Hélàs, malgré les nombreux exemples, je ne parviens pas à trouver la bonne approche. Merci.

Pour ton code, Je vérifie les résultats et reviens pour te confirmer les résultats. En fait, je voudrais le résultat dans un message. Mais c'est une première approche pour vérifier les résultats escomptés.

Le message serait une liste (MsgBox): date - famille - sous-famille (manquants)

Voilà, j'ai un copier/coller du code

Option Explicit

Sub retrouver_valeurs()
    Dim Ltest As Integer, Lref As Integer, i As Integer, j As Long, c As Long, ii As Long
    Dim Tbtest(), Tbref(), TbR, TbT, Tbtest2()
    Dim DicTest As Object, DicRef As Object, d As Object
    Dim tblDate, a, b(), cle
    tblDate = Feuil4.[K2:L9]
    With Sheets("BD_Ref")
        Lref = .Range("A" & Rows.Count).End(xlUp).Row
        Tbref = .Range("c2:d" & Lref).Value
        Set DicRef = CreateObject("Scripting.Dictionary")
        Set d = CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(Tbref)
            If Tbref(i, 2) <> "M1" Then    'on ne prend pas la famille M1
                DicRef(Tbref(i, 1) & Tbref(i, 2)) = ""
            End If
        Next i
    End With

    With Sheets("BD_Test")
        Ltest = .Range("A" & Rows.Count).End(xlUp).Row
        Tbtest = .Range("A2:R" & Ltest).Value

        Set DicTest = CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(tblDate)
            c = 0
            For j = 1 To UBound(Tbtest)
                d(Tbtest(j, 4)) = ""
                If Tbtest(j, 18) = "M" Or Tbtest(j, 18) = "M/A" Then    '**on ne prend que pour Test= M ou M/A
                    If Tbtest(j, 3) <= tblDate(i, 2) Then
                        'cle=famille&sous-famille -----> item= date test
                        ' If Not DicTest.Exists(Tbtest(j, 4) & Tbtest(j, 5)) Then DicTest.Add Tbtest(j, 4) & Tbtest(j, 5), Tbtest(j, 3)
                        DicTest(Tbtest(j, 4) & " - " & Tbtest(j, 5) & " - " & Tbtest(j, 3)) = ""
                    End If
                End If

            Next j
        Next i
        For Each cle In d.keys
            c = 0
            For j = 1 To UBound(tblDate)
                If tblDate(j, 1) = cle Then c = c + 1: Exit For
            Next j

            If c = 0 Then
                ii = ii + 1
                ReDim Preserve b(1 To 1, 1 To ii): b(1, ii) = cle
            End If
        Next cle
    End With

    a = DicTest.keys
    b = Application.Transpose(b)
    Feuil6.[L1].Resize(DicTest.Count) = Application.Transpose(a)
    If d.Count > 0 Then
        Feuil6.[N1].Resize(UBound(b, 1), UBound(b, 2)) = b
    End If
End Sub

Encore merci.

 

[cathodique]

Re : Données manquantes par rapport 2 dates

Re,

Les résultats escomptés ne sont pas au RDV. Je te remercie, c'est déjà un bon début.
J'ai suivi ton code pour essayer de le comprendre. Alors, le code renvoie des combinaisons qui existent dans BD_Test, or c'est l'inverse qu'il me faut. C'est les combinaisons qui n'existent pas, pour compléter la Base.

Il y a aussi des données qui ne doivent pas être renvoyées par le code, celles qui sont en colonne N (feuil4). Ces données concernent des tests de type "CMDP" ou "CSt", or nous ne prenons en compte que les tests "M" et "M/A".

Ce que tu as mis dans tblDate=Feuil4.[K2:L9] représente l'année d'acquistion; c'est à dire qu'une famille ne peut avoir de données en BD_test pour une date antérieure à celle-ci.

Exemple: pour la date 18/12/1995 pour la famille L1, le code devrait renvoyer d'ajouter les données dans BD_Test. Mais étant donné, que la famille a été acquise en 1996, le code ne devrait rien renvoyer.

Je reconnais que c'est compliqué, c'est pour cela que tourne en rond. Il y a aussi une condition que je n'ai pas pu intégrer dans ton code. On prend bien TbTest(j,18)="M" or TbTest(j,18)="M/A" j'ai rajouté And TbTest(j,4)="M1", mais le résultat est toujours faux (en effet, la famille M1 ne doit pas être prise en compte car cédée).

Merci beaucoup.

 

[cathodique]

Re : Données manquantes par rapport 2 dates

Re,

En apportant quelques modifications à ton code, on obtient le résultat inverse.
Dans l'état actuel, on obtient toutes les combinaisons présentent sur la feuille BD_Test. Ajout ou correction là où il y a des "/"

Sub retrouver_valeurs()
    Dim Ltest As Integer, Lref As Integer, i As Integer, j As Long, c As Long, ii As Long
    Dim Tbtest(), Tbref(), TbR, TbT, Tbtest2()
    Dim DicTest As Object, DicRef As Object, d As Object
    Dim tblDate, a, b(), cle

    tblDate = Feuil4.[K2:L9]

    With Sheets("BD_Ref")
        Lref = .Range("A" & Rows.Count).End(xlUp).Row
        Tbref = .Range("c2:d" & Lref).Value
        Set DicRef = CreateObject("Scripting.Dictionary")
        Set d = CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(Tbref)
            If Tbref(i, 2) <> "M1" Then    'on ne prend pas la famille M1
                DicRef(Tbref(i, 1) & Tbref(i, 2)) = ""
            End If
        Next i
    End With

    With Sheets("BD_Test")
        Ltest = .Range("A" & Rows.Count).End(xlUp).Row
        Tbtest = .Range("A2:R" & Ltest).Value

        Set DicTest = CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(tblDate)
            ' c = 0
            For j = 1 To UBound(Tbtest)
                d(Tbtest(j, 3)) = ""    'd(Tbtest(j, 4)) = ""  '///colonne date
                If Tbtest(j, 18) = "M" Or Tbtest(j, 18) = "M/A" Then    'on ne prend que pour Test= M ou M/A
                    If Tbtest(j, 4) <> "M1" Then        '////pour exclure M1 du traitement
                        If Year(Tbtest(j, 3)) <= tblDate(i, 2) Then     '/////on extrait année de Tbtest pour comparer
                            'cle=famille&sous-famille -----> item= date test
                            ' If Not DicTest.Exists(Tbtest(j, 4) & Tbtest(j, 5)) Then DicTest.Add Tbtest(j, 4) & Tbtest(j, 5), Tbtest(j, 3)
                            DicTest(Tbtest(j, 4) & " - " & Tbtest(j, 5) & " - " & Tbtest(j, 3)) = ""
                        End If
                    End If
                End If
            Next j
        Next i
        
        For Each cle In d.keys
            c = 0
            For j = 1 To UBound(tblDate)
                If tblDate(j, 1) = cle Then c = c + 1: Exit For
            Next j

            If c = 0 Then
                ii = ii + 1
                ReDim Preserve b(1 To 1, 1 To ii): b(1, ii) = cle
            End If
        Next cle
    End With

    a = DicTest.keys
    b = Application.Transpose(b)
    Feuil5.[A38].Resize(DicTest.Count) = Application.Transpose(a)
    If d.Count > 0 Then
        Feuil5.[C38].Resize(UBound(b, 1), UBound(b, 2)) = b
    End If
End Sub

Je voudrais obtenir un message récapitulant les combinaisons manquantes.
Pour info, si ça peut être utile. Pour ces dates, 30/10/1991 et 01/08/1993, le code ne doit rien renvoyer.

Merci par avance. Bonne soirée.

 

[Bebere]

Re : Données manquantes par rapport 2 dates

bonjour Cathodique
l'essai du dernier code ne donne rien
de mon côté rien trouvé
la date acquisition est la date butée,les dates à tester( <=) vont reprendre les précédentes
il faudrait peut être testé sur une année seulement

pour le moment j'essaye avec le filtre
je dois m'absenter,je continue à mon retour

 

[cathodique]

Re : Données manquantes par rapport 2 dates

Bonjour Bebere,

Je te remercie beaucoup de te pencher sur mon problème. De mon côté ça ne donne rien.
J'ai fait pas mal de tests pas concluants, surtout qu'il y a beaucoup de cas et encore je n'ai pas pris le fichier original.

J'ai une idée mais je n'arrive pas à la concrétiser par code. Je te l'expose bien que ne sachant pas vraiment si c'est la bonne approche. Pour ton information, le petit tableau qui récapitule les dates d'acquisition n'existe sur mon fichier original.

Passons à l'idée, DicTest comprend toutes les combinaisons présentes dans Bd_Test (sous la forme: famille-sousfamille-date)
ensuite DicRef comprend toutes les combinaisons possibles à stocker dans BD_Test sous la forme: famille-sousfamille)
Si on prend dans un dictionnaire les dates de BD_Test (par ex: dDatTest) et qu'on crée un nouveau tableau (pour qu'il ait la même structure que DicTest) avec DicRef et dDatTest, ici l'affectation des dates doit respecter la date d'acquisition. Et là, je me noie.
Si on peut surmonter cette difficulté, on obtiendra 2 tableaux ayant la même structure à comparer.
en effet, dans le dernier il y aura toutes les combinaisons possibles datées et dans DicTest les combinaisons qui existent dèjà.

Je joins un fichier de Boisgontier dont je n'ai pas encore bien compris le code. Tu pourrais le comprendre mieux que moi.

Merci beaucoup.

Bon week-end.

 

[Bebere]

Re : Données manquantes par rapport 2 dates

Cathodique
fait aussi plusieurs essais ,sans résultat
tu les obtiens comment ces dates d'acquisition et si le tableau n'existe pas comment obtenir ces dates
en recap!02 mis cette formule

=SOMMEPROD((ANNEE(BD_Test!$C$2:$C$10000)=ANNEE(L9))*1)

à tirer vers le bas
pour le moment j'essaye un code avec le filtre pour les 2 tableaux

 

[cathodique]

Re : Données manquantes par rapport 2 dates

Oups! J'avais cru l'avoir dit dans mon précédent post. Excuses, c'est une omission de ma part.
Je voulais dire que je mettrai les dates d'acquisition dans le code en dur. On continue avec tblDate comme tu l'as fait.
Je viens juste de rentrer pour une obligation personnelle (renouveler mon traitement). Je n'ai donc rien fait cette après-midi.

pour le moment j'essaye un code avec le filtre pour les 2 tableaux

Tu as raison, je vais réduire le fichier à une seule année. Je pense que ça sera plus clair.

Merci. à tantôt.

 

[cathodique]

Re : Données manquantes par rapport 2 dates

Bonsoir,

je n'ai laissé qu'une seule date dans ce nouveau fichier. J'ai mis les dates d'acquisition dans le code (un tableau).
sur la feuille Recap2, on trouve quelques explications qui j'espère seront claires. Je n'ai pas obtenu de résultats satisfaisants.

Merci et très bon week-end.

 

[Bebere]

Re : Données manquantes par rapport 2 dates

bonjour Cathodique
un code pour faire un tableau sur 3 colonnes,déclarer Tbr comme suit tbr()

For i = 2 To UBound(Tbref)
DicRef(Tbref(i, 3) & "|" & Tbref(i, 4)) = ""
Next i
i = 0
For Each cle In DicRef.keys
i = i + 1
ReDim Preserve tbR(1 To 3, 1 To i)
tbR(1, i) = Mid(cle, 1, InStr(cle, "|") - 1)
tbR(2, i) = Mid(cle, InStr(cle, "|") + 1)
tbR(3, i) = "18/12/1995"
Next cle

tbR = Application.Transpose(tbR)

Feuil5.[L3].Resize(UBound(tbR, 1), UBound(tbR, 2)) = tbR

 

[cathodique]

Re : Données manquantes par rapport 2 dates

Merci beaucoup Bebere pour ton aide.

Mais j'avoue que cette affaire dépasse de très loin mes compétences. Etant donné que j'ai codé, recodé, décodé et je pense même tricoter. Je ne vois pas le bout du tunnel.

J'ai remplacé le code concernant DicRef par ton dernier code mais il s'arrête sur la ligne:
DicRef(Tbref(i, 3) & "|" & Tbref(i, 4)) = ""
l'erreur : "l'indice n'appartient pas à la selection". J'ai mis for i=1 au lieu de 2 mais ça ne passe.

Merci encore pour tout. Je pense bien jeter l'éponge du moins pour aujourd'hui. Je reprendrai plus tard, ça m'a fatigué.
Bonne soirée.

 

[Bebere]

Re : Données manquantes par rapport 2 dates

je n'ai pas beaucoup de temps bécause visites et demain idem
sî j'ai quelque chose de valable tu auras une réponse
à tête reposée c'est mieux
réfléchi comme il faut pour bien énoncer le problème

 

[cathodique]

Re : Données manquantes par rapport 2 dates

Merci. Tu sais je ne suis pas du tout pressé. J'ai tout mon temps car tout ce que je fais est ludique. je me fais plaisir pour apprendre et découvrir des choses que je n'avais pas eu le privilège de pratiquer.

Tu as raison, j'ai peut-être mal exposé le problème. J'ai proposé de solutionner le problème avec les dictionnaires car les données sont en doublons. C'est peut-être la plus mauvaise approche.

Encore merci, bon dimanche et bonnes visites.

 

[cathodique]

Re : Données manquantes par rapport 2 dates

Pour illustrer mon problème, la feuille BD_Ref répertorie des engins (famille) , ces engins sont composé d'organes (sousfamille) et des points de tests(x1 à x5).

On effectue des tests sur chaque organe qu'on stocke sur la feuille BD_Test. Les données pour établir le formulaire de test sont extraites de la feuille BD_Ref.

Donc pour chaque engin et pour chaque organe de la feuille BD_Ref, doit être stocker sur la feuille BD_Test d'où une date de test.

J'arrive à la date d'acquistion, le code ne doit pas renvoyer pour la date X, l'engin Y et l'organe Z est manquant alors que la date d'acquisition de l'engin est supérieure à la date X du test (c'est une abberation). En effet, un engin acquis en 2005 ne peut avoir un rapport de test en 2000.

La BD_Test n'étant pas à jour et les différents tests enregistrés anarchiquement d'où cette nécessité de connaitre ce qui manque.

Ne seront traités que les tests M ou M/A (col18 feuille BD_test), l'engin M1 sera exclu car cédé (col4 feuil BD_Test et Col3 feuil BD_Ref).

Avec ce nouveau fichier voici le résultat attendu dans MsgBox:

15/06/2005 - famille:T1 - sousfamille:IA/S2
15/06/2005 - famille:T1 - sousfamille:S2/PF
25/02/2006 - famille:RO1 - sousfamille:MD/S5

J'espère que cette fois-ci, j'ai été plus explicite.

Merci par avance.