Récupérer les critères de filtre dans des tableaux

Bonjour,

Je suis bloquée depuis plusieurs jours sur un même problème, j'espère que quelqu'un pourra m'aider à trouver la solution. Voilà à quoi ressemble ma base de données :

Elle contient une colonne DATE, une colonne HEURE, une colonne TANK et une colonne TEXTE. Dans cette base de données, certaines lignes sont dupliquées (ex : lignes 2 et 3) et d'autres sont malencontreusement présentes puisqu'il ne peut pas y avoir deux mêmes actions (soutirage, consignation, remplissage) pour un même tank à une même date à un laps de temps inférieur à 5h (ex : lignes 7 et 8, deux soutirages du tank 7 le 06/01/20 avec un laps de temps de 37min). Mon but est donc de supprimer les lignes dupliquées et malencontreusement présentes (lignes grisées dans le fichier). Mon raisonnement était donc de filtrer la colonne A selon un premier critère, puis la colonne C selon un premier critère et enfin la colonne D selon un premier critère, de supprimer les lignes restantes pour lesquelles l'heure d'intervalle avec la ligne du dessus est inférieure à 5h. L'idée était ensuite de boucler cela sur chaque critère de chaque colonne. Voici le code que j'ai écrit :

Sub Suppression()
    Dim Array1(2, 0)
    Array1(0, 0) = "06/01/2020"
    Array1(1, 0) = "07/01/2020"
    Array1(2, 0) = "08/01/2020"
    Dim Array2(6, 0)
    Array2(0, 0) = "TANK 6"
    Array2(1, 0) = "TANK 7"
    Array2(2, 0) = "TANK 8"
    Array2(3, 0) = "TANK 9"
    Array2(4, 0) = "TANK 10"
    Array2(5, 0) = "TANK 11"
    Array2(6, 0) = "TANK 12"
    Dim Array3(2, 0)
    Array3(0, 0) = "CONSIGNATION"
    Array3(1, 0) = "REMPLISSAGE"
    Array3(2, 0) = "SOUTIRAGE"
    For i = LBound(Array1) To UBound(Array1)
        Columns("A").AutoFilter Field:=1, Criteria1:=Array1(i, 0)
        For j = LBound(Array2) To UBound(Array2)
            Columns("C").AutoFilter Field:=3, Criteria1:=Array2(j, 0)
            For k = LBound(Array3) To UBound(Array3)
                Columns("D").AutoFilter Field:=4, Criteria1:=Array3(k, 0)
                Set Plage = Range("B2:B" & Range("B65536").End(xlUp).Row).SpecialCells(xlVisible)
                For Each Cell In Plage
                    Cell.Select
                    If Cell.Value - Cell.Offset(1, 0).Value < 5 Then
                        Cell.Offset(1, 0).EntireRow.Delete
                    End If
                Next Cell
            Next k
        Next j
    Next i
End Sub

Tout fonctionne mais j'ai créé manuellement les tableaux Array1 (qui contient les critères de filtre de la colonne A), Array2 (qui contient les critères de filtre de la colonne C) et Array3 (qui contient les critères de filtre de la colonne D) or je ne peux pas faire cela avec toute ma base de données. J'aimerais trouver un moyen d'automatiser la construction des tableaux Array1, Array2 et Array3 dans le code.

Potentielles solutions pour l'Array1 :

-parcourir toutes les lignes de la colonne A et ajouter dans Array1 la valeur de la cellule si elle n'est pas déjà présente, j'ai testé le code suivant mais ça ne fonctionne pas :

    Dim Array1() As Variant 
    Set Plage = Range("A" & Cells(Rows.Count, 1).End(xlUp).Row) 
    For Each Cell in Plage 
        If Cell.Value Not In Array1 Then 
            Redim Preserve Array1(UBound(Array1)+1) 
            Array1(UBound(Array1))=Cell.Value 
        End If 
    Next Cell

-essayer avec Autofilter.Filters() mais je n'y parviens pas

Je vous remercie d'avance !

PS : le fichier est trop lourd pour que je le dépose ici...

Léa

Bonjour,

Si j'ai bien compris la problématique ce code devrait faire le même travail:

Sub nettoyage()
Dim tableau As Variant
Dim PlageSupr As Range

Application.ScreenUpdating = False

'initialisations
tableau = Range("a1").CurrentRegion

'parcours du tableau pour nettoyage
For i = LBound(tableau, 1) + 2 To UBound(tableau, 1)
    If tableau(i, 3) = tableau(i - 1, 3) And tableau(i, 4) = tableau(i - 1, 4) Then 'si même tank et même action que la ligne précédente
        If CDate((tableau(i, 1) + tableau(i, 2)) - (tableau(i - 1, 1) + tableau(i - 1, 2))) < TimeSerial(5, 0, 0) Then 'si moins de 5h de décalage entre les actions
            If Not PlageSupr Is Nothing Then
                Set PlageSupr = Union(PlageSupr, Range("a" & i)) 'ajout de la ligne pour suppression plus tard
            Else
                Set PlageSupr = Range("a" & i)
            End If
        End If
    End If
Next i

If Not PlageSupr Is Nothing Then 'si il y a des lignes à supprimer
    PlageSupr.Rows.Delete
End If

Application.ScreenUpdating = True
End Sub

Je joins le fichier avec lequel je l'ai testé.

Bonjour,

Je vous remercie beaucoup de votre réponse. Le problème de ce code est que ça marche que lorsque les deux lignes se suivent. Il peut arriver parfois qu'une ligne se glisse entre les deux comme ci dessous (c'est pour ça que je fonctionnais par filtre) :

Bonsoir,

En effet ce problème n'apparaissait pas sur le seul screen que je possédais, je vais voir pour modifier le code afin de prendre cet écart en compte.

Voici le code modifié pour des lignes séparées:

Sub nettoyage()
Dim tableau As Variant
Dim PlageSupr As Range
'Dim DicoTanks As New Dictionary
Dim jour As Date
Dim DicoTanks

Application.ScreenUpdating = False

'initialisations
tableau = Range("a1").CurrentRegion
Set DicoTanks = CreateObject("Scripting.Dictionary")
DicoTanks.Add tableau(2, 3) & "_" & tableau(2, 4), tableau(2, 1) + tableau(2, 2)

'parcours du tableau pour nettoyage
For i = LBound(tableau, 1) + 2 To UBound(tableau, 1)
    cle = tableau(i, 3) & "_" & tableau(i, 4)
    jour = tableau(i - 1, 1) + tableau(i - 1, 2)
    If DicoTanks.Exists(cle) Then
        If CDate(DicoTanks(cle) - jour) < TimeSerial(5, 0, 0) Then 'si moins de 5h de décalage entre les actions
            If Not PlageSupr Is Nothing Then
                Set PlageSupr = Union(PlageSupr, Range("a" & i)) 'ajout de la ligne pour suppression plus tard
            Else
                Set PlageSupr = Range("a" & i)
            End If
        Else
            DicoTanks.Remove (cle)
            DicoTanks.Add cle, jour
        End If
    Else
        DicoTanks.Add cle, jour
    End If
Next i

If Not PlageSupr Is Nothing Then 'si il y a des lignes à supprimer
    PlageSupr.Rows.Delete
End If

Application.ScreenUpdating = True
End Sub

Bonjour,

Merci pour votre réactivité ! J'aimerais bien être aussi performante que vous en VBA ! Cependant j'ai une erreur et cela ne fonctionne pas sur mon ordinateur, je suis sous mac je ne sais pas si ça change quelque chose.

De plus, j'ai annoté des questions sur les lignes de code que je ne comprenais pas, pourriez-vous m'expliquer s'il vous plait ? Je n'ai jamais manipulé de dictionnaire en VBA c'est peut être pour ça que je suis un peu perdue :)

Je vous remercie en tout cas !

Léa

Sub nettoyage()
Dim tableau As Variant
Dim PlageSupr As Range
'Dim DicoTanks As New Dictionary
Dim jour As Date
Dim DicoTanks

Application.ScreenUpdating = False

'initialisation
tableau = Range("A1").CurrentRegion
Set DicoTanks = CreateObject("Scripting.Dictionary")

DicoTanks.Add tableau(2, 3) & "_" & tableau(2, 4), tableau(2, 1) + tableau(2, 2) 'Je ne comprends pas cette ligne, "_" permet de créer une clé unique à partir de la valeur de TANK et de TEXTE ? Et la suite correspond à l'item ? Ajouter la colonne DATE et HEURE nous donne une cellule de quel format ?

'parcours du tableau pour nettoyage
For i = LBound(tableau, 1) + 2 To UBound(tableau, 1) 'L indice le plus bas est 0 de base avec LBound ? Le fait d'ajouter 2 à LBound permet de se retrouver à la ligne 2 c'est bien cela ?
    cle = tableau(i, 3) & "_" & tableau(i, 4)
    jour = tableau(i - 1, 1) + tableau(i - 1, 2)
    If DicoTanks.Exists(cle) Then 
        If CDate(DicoTanks(cle) - jour) < TimeSerial(5, 0, 0) Then 'Je ne comprends pas du tout cette ligne, on fait une soustraction entre la clé TANK_TEXTE et le JOUR_DATE ?
            If Not PlageSupr Is Nothing Then
                Set PlageSupr = Union(PlageSupr, Range("A" & i)) 'ajout de la ligne pour suppression plus tard
            Else
                Set PlageSupr = Range("A" & i)
            End If
        Else
            DicoTanks.Remove (cle) 'Pourquoi on supprime la clé
            DicoTanks.Add cle, jour 'Pour la rajouter ici ?
        End If
    Else
        DicoTanks.Add cle, jour
    End If
Next i

If Not PlageSupr Is Nothing Then 'si il y a des lignes à supprimer
    PlageSupr.Rows.Delete
End If

Application.ScreenUpdating = True
End Sub

J'ai tout de même à disposition un ordinateur Windows, je viens de tester et la solution proposée me supprime des lignes qui ne devraient pas être supprimées. Pour le premier jour ça fonctionne mais pour le deuxième jour ça supprime les lignes qui comportaient les mêmes actions et mêmes tanks que le jour précédent, hors ce n'est pas ce que l'on veut. Nous voulons uniquement supprimer les lignes qui auraient les mêmes actions sur les mêmes tanks à moins de 5h d'intervalle (attention aussi au changement de jour, si on remplit un tank à 23h le 06/02/20 et qu'une ligne indique qu'on le re remplit à 2h le 07/01/20 il faudra supprimer la seconde ligne).

Bonjour,

désolé d'apprendre que les dictionnaires posent problèmes avec MAC et qu'en plus ça ne fonctionne pas bien, serait-t-il possible de me fournir un jeu de données un peu plus représentatif de votre tableau pour que je puisse faire des tests et débuguer tout?

Je me tournerai vers le souci de compatibilité MAC par la suite en espérant trouver une solution.

Pour les explications je commencerai une fois que tout fonctionnera également, je risque de modifier pas mal de choses.

EDIT:

Je propose quand même une modification du code car j'ai remarqué une erreur.

Encore une erreur trouvée, je reposte le fichier qui cette fois ne devrait plus en avoir.

Bonjour à tous, Salut Ausecour,

Au cas où, récemment, je me suis penché sur la question et il se trouve que Jacques Boisgontier (merci à lui !!! ) a prévu un objet similaire au dictionnaire utilisable sur mac :

http://boisgontierjacques.free.fr/pages_site/classe.htm#dict

3GB a écrit :

Bonjour à tous, Salut Ausecour,

Au cas où, récemment, je me suis penché sur la question et il se trouve que Jacques Boisgontier (merci à lui !!! ) a prévu un objet similaire au dictionnaire utilisable sur mac :

http://boisgontierjacques.free.fr/pages_site/classe.htm#dict

Cdlt,

Oh je vois, il passe par un module de classe! Pas bête!

Oui, et pour le coup, c'est très utile !

Mais dans ce cas, il faut 2 procédures, une pour Windows et une pour Mac car l'objet n'est pas le même, même si le fonctionnement est identique.

La dernière version d'AuSecour semble marcher parfaitement ! Merci à lui !

Merci à vous tous pour vos conseils !

Super!

Je peux donc passer par la partie explication vis-à-vis des questions, pour MAC on verra un peu plus tard:

DicoTanks.Add tableau(2, 3) & "_" & tableau(2, 4), tableau(2, 1) + tableau(2, 2)

Je ne comprends pas cette ligne, "_" permet de créer une clé unique à partir de la valeur de TANK et de TEXTE ? Et la suite correspond à l'item ? Ajouter la colonne DATE et HEURE nous donne une cellule de quel format ?

J'utilise souvent "_" par sécurité, ce n'est pas forcément nécessaire mais ça me permet de séparer les données, en effet la suite correspond à l'item, avec les objets dictionnaire on donne d'abord la clé, puis l'item. Les dates et les heures sont toutes des dates en réalité, ce sont juste des nombres qu'on affiche de façon lisible, les heures sont simplement des morceaux de jour, 44259,5 correspond à la date d'aujourd'hui à 12h00, la moitié du jour, en faisant la somme d'une date et d'une heure on a une date.

For i = LBound(tableau, 1) + 2 To UBound(tableau, 1)

L indice le plus bas est 0 de base avec LBound ? Le fait d'ajouter 2 à LBound permet de se retrouver à la ligne 2 c'est bien cela ?

Alors pas toujours, ça dépend de la façon dont est déclaré un tableau, si tu passes par Array ou tableau(5) par exemple, tu auras bien 0 en index de départ, mais si tu utilises des Range pour initialiser ton tableau, ton premier numéro d'index est 1. Il y a aussi Option Base : https://docs.microsoft.com/fr-fr/office/vba/language/reference/user-interface-help/option-base-state...

Ici le +2 permet de passer l'en-tête et la première ligne qui n'ont pas besoin d'être traitées, elle ne peut pas déjà être en doublon comme c'est la première ligne de données.

If CDate(jour - DicoTanks(cle)) < TimeSerial(5, 0, 0) Then

Je ne comprends pas du tout cette ligne, on fait une soustraction entre la clé TANK_TEXTE et le JOUR_DATE ?

Pas tout à fait, j'ai corrigé cette ligne d'ailleurs car j'avais mal fait le calcul, je prends la date actuelle à laquelle je soustrais la valeur enregistrée dans le dictionnaire à la clé qu'on lui fournis, je convertis le tout en date par sécurité, puis je compare avec TimeSerial qui donne 5h.

DicoTanks.Remove (cle)
DicoTanks.Add cle, jour

Pourquoi on supprime la clé pour la rajouter ici?

On peut utiliser DicoTanks(cle) = jour

Je pensais que ça ne fonctionnerait pas mais dans ce cas précis ça fonctionne, j'ai un peu du mal à bien comprendre les dictionnaires par moment, parfois je peux modifier la valeur se trouvant dedans, parfois non, je pensais que ça ne fonctionnerait pas, donc je suis partis du principe d'enlever la donnée pour la remplacer avec une nouvelle.

Je joins le fichier avec la correction pour la question précédente, puisque ça marche autant s'en servir.

Ausecour, je rebondis sur le dernier point, étant moi-même en train de chercher à percer les mystères de l'objet dictionary . Voici ce que j'en ai compris :

sub pourcouleurs()

dico.Add clé, item 'méthode qui ajoute une clé et lui affecte un item '<<< BUG SI LA CLE EXISTE DEJA
dico.Key(clé) = nvlleclé 'proprieté qui modifie une clé '<<< BUG SI LA CLE clé N'EXISTE PAS
dico.Item(clé) = nvlitem 'propriété qui modifie l'item d'une clé '<<< BUG si LA CLE N'EXISTE PAS

dico(clé) = item 'méthode qui ajoute une clé lorqu'elle n'existe pas et lui affecte un item ou alors modifie son item si elle existe déjà (TRES PRATIQUE !)

Donc de mon point de vue, il vaut mieux utiliser la dernière plutôt que la première et la troisième. Et pour la seconde, il faut utiliser la méthode dico.exists(clé) pour contrôler.

Salut 3GB, as-tu déjà essayé d'utiliser un tableau dans un dictionnaire?

Si tu fais par exemple:

Sub test()
Dim tableau(1 To 1, 1 To 3)
Dim Dico As New Dictionary

tableau(1, 1) = "Mathieu"
tableau(1, 2) = "Brioche"
tableau(1, 3) = "test"

Dico.Add 1, tableau
Dico(1)(1, 3) = "orange"
MsgBox Dico(1)(1, 3)
End Sub

Bon c'est un code totalement bidon, mais ça m'est arrivé de vouloir rentrer un tableau à une ligne dans un dictionnaire pour stocker plusieurs colonnes d'informations sans savoir la taille finale du tableau, et étonnament Dico(1)(1,3) permet bien de lire "test", mais ne se modifie pas quand on écrit Dico(1)(1,3) = "orange", ça ne plante pas, ça passe à la ligne suivant comme si de rien était, mais la valeur ne se modifie pas...

Justement, essayé oui, réussi... Non ! Et j'aimerais bien y parvenir !

Attends, j'essaie de décrypter...

Il faut que j'essaie ça !

Et en essayant avec dico.item, ça ne marche pas ?

Sub test()
Dim tableau(1 To 1, 1 To 3)
Dim Dico As New Dictionary

tableau(1, 1) = "Mathieu"
tableau(1, 2) = "Brioche"
tableau(1, 3) = "test"

Dico.Add 1, tableau
Dico.item(1)(1, 3) = "orange"
MsgBox Dico(1)(1, 3)
End Sub

Et non ça ne marche pas malheureusement, le seul truc qui semble fonctionner c'est:

Sub test()
Dim tableau(1 To 1, 1 To 3)
Dim Dico As New Dictionary

tableau(1, 1) = "Mathieu"
tableau(1, 2) = "Brioche"
tableau(1, 3) = "test"

Dico.Add 1, tableau
'Dico.Item(1)(1, 3) = "orange"
tableau(1, 3) = "orange"
Dico(1) = tableau
MsgBox Dico(1)(1, 3)
End Sub

à savoir redéfinir complètement l'item du dictionnaire à chaque fois

Oui, je viens d'essayer, le résultat est le même (rien mais pas de bug).

J'ai essayé avec un monodimensionnel également mais pareil.

Ce n'est pas très pratique ! J'ai du mal à croire qu'on ne puisse pas manipuler des tableaux facilement avec un dico. D'ailleurs, ce qui rend l'objet complexe, c'est qu'on a aucune info sur les clés (du moins chez moi, je ne vois pas les clés, ce n'est pas clair) !

Pour voir les clés j'utilise la propriété Keys qui renvoie leurs collections, sinon pas moyen d'y accéder, quand à la manipulation des items des dictionnaires, j'ai l'impression que le tableau est définis en lecture seule par je ne sais quelle magie, il est possible d'imbriquer plusieurs dictionnaires ensemble et de modifier les dictionnaires qui sont à l'intérieur du premier, mais les tableaux...