Dans un tableau Excel, récupérer dans chaque colonne les éléments suite à un filtre dans 1 colonne

Version imprimable

14/10/2014, 11h41
mouftie

Dans un tableau Excel, récupérer dans chaque colonne les éléments suite à un filtre dans 1 colonne

Bonjour,
J'ai une grande base de données, créée avec l'outil tableau d'excel, donc avec des filtres sur toutes les colonnes.
Je voudrais vérifier des saisies et être sur que si je filtre sur un élément d'une colonne, je n'ai également qu'un seul élément sur les 10 colonnes suivantes.

Je vous explique comment je fais manuellement aujourd'hui
dans la colone D, je filtre le 1er élément, puis je clique dans les filtres des 10 colonnes suivantes et vérifie qu'il n'y a qu'un seul élément présent dans le filtre ; sinon c'est qu'il y a une erreur.
Puis je passe au 2ème élément de la colonne D et reclique dans chaque filtres des 10 colonnes svtes...

Est-ce que quelqu'un peut m'aider à automatiser ma démarche, svp.
Merci
14/10/2014, 14h40
Thautheme

Bonjour Mouftie, bonjour le forum,

Pourrais-tu joindre un petit fichier exemple basé sur ton fichier original avec juste une poignée de données. Ça serait plus clair je pense...
14/10/2014, 16h19
mouftie

1 pièce(s) jointe(s)

Bonjour Thautheme,
Merci d'avoir répondu ; ci-joint un fichier exemple ; il n'y a pas bcp de lignes et de colonnes mais en réalité voir les erreurs c'est plus difficile. surtout dans les cellules numériques comme les n° de téléphone...
Merci de ton aide.

1 pièce(s) jointe(s)

Bonsoir Mouftie, bonsoir le forum,

J'ai eu des problèmes avec le format téléphone ce qui a rallongé le code de la macro commentée ci-dessous :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
Sub Macro1()
Dim O As Object 'déclare la variable O (Onglet)
Dim DL As Long 'déclare la variable DL (Dernière Ligne)
Dim DC As Byte 'déclare la variable DC (Dernière Colonne)
Dim PL As Range 'déclare la variable PL (PLage)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim CEL As Range 'déclare la variable CEL (CELlule)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim I As Long 'déclare la variable I (Incrément)
Dim J As Byte 'déclare la variable J (incrément)
Dim PLV As Range 'déclare la variable PLV (PLage Visible)
Dim TMPC As Variant 'déclare la variable TMPC (tableau TeMProraire de la Colonne)
Dim PLVC As Range 'déclare la variable PLVC (Plage Visible de la Colonne)
Dim K As Byte 'déclare la variable K (incrément)
 
Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set O = Sheets("Feuil1") 'définit l'onglet O
DL = O.Cells(Application.Rows.Count, 3).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne 3 (=C) de l'onglet O
DC = O.Cells(1, Application.Columns.Count).End(xlToLeft).Column 'définit la dernière colonne éditée DC de la ligne 1 de l'onglet O
Set PL = O.Range("C2:C" & DL) 'définit la plage PL (colonne 3 = C)
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For Each CEL In PL 'boucle sur toutes les cellules CEL de la plage PL
    D(CEL.Value) = "" 'alimente le dictionnaire
Next CEL 'prochaine cellule de la boucle
TMP = D.keys 'récupère dans le tableau temporaire TMP les valeurs uniques (sans doublon) du dictionnaire D
For I = 0 To UBound(TMP) 'boucle 1 : sur tous les éléments du tableau TMP
    O.Range("A1").AutoFilter Field:=3, Criteria1:=TMP(I) 'filtre la colonne 3 (=C) de l'onglet O avec l'élément TMP(I) comme critère
    For J = 4 To DC 'boucle 2 : sur les colonnes 4 à DC
        'définit la plage PLV (cellules visibles (non filtrée) de la colonne C décalée de J-3 colonnes à droite
        Set PLV = PL.Offset(0, J - 3).SpecialCells(xlCellTypeVisible)
        If PLV.Cells.Count = 1 Then GoTo suite 'si le nombre de cellules visibles est égal à un, va à l'étiquette "suite"
        Set D = CreateObject("Scripting.Dictionary") 'redéfinit le dictionnaire D
        For Each CEL In PLV 'boucle 3 :sur toutes les cellules CEL de la plage PLV
            D(CEL.Value) = "" 'alimente le dictionnaire D
        Next CEL 'prochaine cellule de la boucle 3
        TMPC = D.keys 'récupère dans le tableau temporaire TMPC les valeurs uniques (sans doublon) du dictionnaire D
        If UBound(TMPC) > 0 Then 'condition 1 : si le nombre d'élément du tableau TMPC est supérieur à 1 (Ubound(TMPC) = 0 => 1 élément)
            For K = 0 To UBound(TMPC) 'boucle 4 : sur tous les éléments du tableau temporaire TMPC
                'filtre la colonne J de l'onglet O avec l'élément TMPC(K) comme critère
                O.Range("A1").AutoFilter Field:=J, Criteria1:=TMPC(K)
                On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
                'définit la plage PLVC des cellules visibles (non filtrée) de la colonne C décalée de J-3 colonens à droite
                Set PLVC = PL.Offset(0, J - 3).SpecialCells(xlCellTypeVisible)
                'quand le critère est un numéro de téléphone avec son format spécial, la ligne ci-dessus génère une erreur
                If Err <> 0 Then 'condition 2 : si une erreur a été générée
                    Err.Clear 'efface l'erreur
                    O.Range("A1").AutoFilter Field:=J 'supprime le filtre automatique avec l'élément TMPC(K)
                    'filtre la colonne J de l'onglet O avec l'élément TMPC(K) au format téléphone comme critère
                    O.Range("A1").AutoFilter Field:=J, Criteria1:=Format(TMPC(K), "0#"" ""##"" ""##"" ""##"" ""##")
                    'définit la plage PLVC des cellules visibles (non filtrée) de la colonne C décalée de J-3 colonens à droite
                    Set PLVC = PL.Offset(0, J - 3).SpecialCells(xlCellTypeVisible)
                End If 'fin de la condition
                On Error GoTo 0 'annule la gestion des erreurs
                'si le nombre de cellules visibles est égal à un, colore la cellule de jaune
                If PLVC.Cells.Count = 1 Then PLVC.Interior.ColorIndex = 6
                O.Range("A1").AutoFilter Field:=J 'supprime le filtre automatique avec l'élément TMPC(K) comme critère
            Next K 'prochain élément de la boucle 4
        End If 'fin de la condition 1
    Next J 'prochaine colonne de la boucle 2
suite: 'étiquette
    O.Range("A1").AutoFilter 'supprime le filtre automatique
Next I 'prochaine élément de la boucle 1
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub

Attention ! Si tas as plusieurs fois la même erreur, par exemple deux fois 16 Av Jean-Jaures dans la colonne E, le code ne te le signalera pas à cause de la ligne 55 :

Code:

If PLVC.Cells.Count = 1 Then PLVC.Interior.ColorIndex = 6

Cela devrait arriver rarement mais je n'ai pas trouver de solution simple à ce problème...

Le fichier :

1 pièce(s) jointe(s)

Bonjour Mouftie, bonjour le forum,

En pièce jointe une version 2 plus efficace qui n'aura pas l'inconvénient de la V01.
Le code :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
Sub Macro1()
Dim O As Object 'déclare la variable O (Onglet)
Dim DL As Long 'déclare la variable DL (Dernière Ligne)
Dim DC As Byte 'déclare la variable DC (Dernière Colonne)
Dim PL As Range 'déclare la variable PL (PLage)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim CEL As Range 'déclare la variable CEL (CELlule)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim I As Long 'déclare la variable I (Incrément)
Dim J As Byte 'déclare la variable J (incrément)
Dim PLV As Range 'déclare la variable PLV (PLage Visible)
Dim TMPC As Variant 'déclare la variable TMPC (tableau TeMProraire de la Colonne)
Dim PLVC As Range 'déclare la variable PLVC (Plage Visible de la Colonne)
Dim K As Byte 'déclare la variable K (incrément)
Dim TN() As Byte 'déclare le tableau de variables indexées TN (Tableau des Nombres)
Dim L As Byte 'déclare la variable L (incrément)
Dim MAX As Byte 'déclare la varialbe MAX
 
Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set O = Sheets("Feuil1") 'définit l'onglet O
DL = O.Cells(Application.Rows.Count, 3).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne 3 (=C) de l'onglet O
DC = O.Cells(1, Application.Columns.Count).End(xlToLeft).Column 'définit la dernière colonne éditée DC de la ligne 1 de l'onglet O
Set PL = O.Range("C2:C" & DL) 'définit la plage PL (colonne 3 = C)
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For Each CEL In PL 'boucle sur toutes les cellules CEL de la plage PL
    D(CEL.Value) = "" 'alimente le dictionnaire
Next CEL 'prochaine cellule de la boucle
TMP = D.keys 'récupère dans le tableau temporaire TMP les valeurs uniques (sans doublon) du dictionnaire D
For I = 0 To UBound(TMP) 'boucle 1 : sur tous les éléments du tableau TMP
    O.Range("A1").AutoFilter Field:=3, Criteria1:=TMP(I) 'filtre la colonne 3 (=C) de l'onglet O avec l'élément TMP(I) comme critère
    For J = 4 To DC 'boucle 2 : sur les colonnes 4 à DC
        'définit la plage PLV (cellules visibles (non filtrée) de la colonne C décalée de J-3 colonnes à droite
        Set PLV = PL.Offset(0, J - 3).SpecialCells(xlCellTypeVisible)
        If PLV.Cells.Count = 1 Then GoTo suite 'si le nombre de cellules visibles est égal à un, va à l'étiquette "suite"
        Set D = CreateObject("Scripting.Dictionary") 'redéfinit le dictionnaire D
        For Each CEL In PLV 'boucle 3 :sur toutes les cellules CEL de la plage PLV
            D(CEL.Value) = "" 'alimente le dictionnaire D
        Next CEL 'prochaine cellule de la boucle 3
        TMPC = D.keys 'récupère dans le tableau temporaire TMPC les valeurs uniques (sans doublon) du dictionnaire D
        If UBound(TMPC) > 0 Then 'condition 1 : si le nombre d'élément du tableau TMPC est supérieur à 1 (Ubound(TMPC) = 0 => 1 élément)
            For K = 0 To UBound(TMPC) 'boucle 4 : sur tous les éléments du tableau temporaire TMPC
                ReDim Preserve TN(K) 'redimensionne le tableau TN
                TN(K) = Application.WorksheetFunction.CountIf(PLV, TMPC(K)) 'définit la varaible indexée TN(K) (nombre d'occurrences de TMPC(K) dans la plage PLV)
            Next K 'prochain élément de la boucle 4
            For K = 0 To UBound(TN) 'boucle 5 : sur les éléments tu tableau TN
                For L = 0 To UBound(TN) 'boucle 6 : sur les éléments tu tableau TN
                    If TN(L) > TN(K) Then MAX = L 'récupère dans la variable MAX l'élément qui a le plus grand nombre d'occurrences dans la plage PLV
                Next L 'prochaine élément de la boucle 6
            Next K 'prochaine élément de la boucle 5
            'filtre la colonne J de l'onglet O avec les éléments différents ded TMPC(MAX) comme critère
            O.Range("A1").AutoFilter Field:=J, Criteria1:="<>" & TMPC(MAX)
            On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
            'définit la plage PLVC des cellules visibles (non filtrée) de la colonne C décalée de J-3 colonens à droite
            Set PLVC = PL.Offset(0, J - 3).SpecialCells(xlCellTypeVisible)
            'quand le critère est un numéro de téléphone avec son format spécial, la ligne ci-dessus génère une erreur
            If Err <> 0 Then 'condition 2 : si une erreur a été générée
                Err.Clear 'efface l'erreur
                O.Range("A1").AutoFilter Field:=J 'supprime le filtre automatique avec l'élément TMPC(K)
                'filtre la colonne J de l'onglet O avec les éléments différents ded TMPC(MAX) comme critère
                O.Range("A1").AutoFilter Field:=J, Criteria1:="<>" & Format(TMPC(MAX), "0#"" ""##"" ""##"" ""##"" ""##")
                'définit la plage PLVC des cellules visibles (non filtrée) de la colonne C décalée de J-3 colonens à droite
                Set PLVC = PL.Offset(0, J - 3).SpecialCells(xlCellTypeVisible)
            End If 'fin de la condition
            On Error GoTo 0 'annule la gestion des erreurs
            'si le nombre de cellules visibles est égal à un, colore la cellule de jaune
            PLVC.Interior.ColorIndex = 6
            O.Range("A1").AutoFilter Field:=J 'supprime le filtre automatique avec l'élément TMPC(K) comme critère
        End If 'fin de la condition 1
    Next J 'prochaine colonne de la boucle 2
suite: 'étiquette
    O.Range("A1").AutoFilter 'supprime le filtre automatique
Next I 'prochaine élément de la boucle 1
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub

Le Fichier :

15/10/2014, 09h55
mouftie

Bonjour Thauthème,

Whoa, quel travail ! merci infiniment, surtout pour ta description de toutes les actions, moi qui essaie de comprendre les Arrays, c'est très instructif.
De plus (et c'est aussi important) ça répond complètement non à ma demande, mais à mes espoirs. :lol:
C'est parfait

Encore mille fois merci du temps que tu as passé pour moi.
Bonne journée.
15/10/2014, 17h22
mouftie

1 pièce(s) jointe(s)

Bonsoir Thauthème,
J'ai un petit pb...
à partir d'une grandeur de la BdD, j'ai un message d'erreur "Impossible de lire la propriété Countif de la classe WorksheetFunction" sur la partie de code :

Code:

TN(K) = Application.WorksheetFunction.CountIf(PLV, TMPC(K)) 'définit la varaible indexée TN(K) (nombre d'occurrences de TMPC(K) dans la plage PLV)

Je te joins un nouveau fichier un peu plus long que le 1er (mais moins que le mien - 2000 lignes).
Si tu peux voir le pb, stp, ce serait sympa
Merci
15/10/2014, 22h45
Thautheme

Bonsoir Mouftie, bonsoir le forum,

Désolé mais je n'ai pas un de plantage avec le nouvel exemple envoyé...
17/10/2014, 08h17
Thautheme

Bonjour Mouftie, bonjour le forum,

Mouftie ne moufte plus... J'en déduis que son problème est résolu !?