IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Dans un tableau Excel, récupérer dans chaque colonne les éléments suite à un filtre dans 1 colonne [XL-2007]


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre éclairé
    Femme Profil pro
    reconversion en cours
    Inscrit en
    Juillet 2009
    Messages
    637
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : reconversion en cours
    Secteur : Conseil

    Informations forums :
    Inscription : Juillet 2009
    Messages : 637
    Par défaut 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

  2. #2
    Membre Expert Avatar de Thautheme
    Homme Profil pro
    salarié
    Inscrit en
    Août 2014
    Messages
    1 373
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 64
    Localisation : France, Hérault (Languedoc Roussillon)

    Informations professionnelles :
    Activité : salarié

    Informations forums :
    Inscription : Août 2014
    Messages : 1 373
    Par défaut
    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...

  3. #3
    Membre éclairé
    Femme Profil pro
    reconversion en cours
    Inscrit en
    Juillet 2009
    Messages
    637
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : reconversion en cours
    Secteur : Conseil

    Informations forums :
    Inscription : Juillet 2009
    Messages : 637
    Par défaut
    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.
    Fichiers attachés Fichiers attachés

  4. #4
    Membre Expert Avatar de Thautheme
    Homme Profil pro
    salarié
    Inscrit en
    Août 2014
    Messages
    1 373
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 64
    Localisation : France, Hérault (Languedoc Roussillon)

    Informations professionnelles :
    Activité : salarié

    Informations forums :
    Inscription : Août 2014
    Messages : 1 373
    Par défaut
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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 :
    Fichiers attachés Fichiers attachés

  5. #5
    Membre Expert Avatar de Thautheme
    Homme Profil pro
    salarié
    Inscrit en
    Août 2014
    Messages
    1 373
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 64
    Localisation : France, Hérault (Languedoc Roussillon)

    Informations professionnelles :
    Activité : salarié

    Informations forums :
    Inscription : Août 2014
    Messages : 1 373
    Par défaut
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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 :
    Fichiers attachés Fichiers attachés

  6. #6
    Membre éclairé
    Femme Profil pro
    reconversion en cours
    Inscrit en
    Juillet 2009
    Messages
    637
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : reconversion en cours
    Secteur : Conseil

    Informations forums :
    Inscription : Juillet 2009
    Messages : 637
    Par défaut
    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.
    C'est parfait

    Encore mille fois merci du temps que tu as passé pour moi.
    Bonne journée.

  7. #7
    Membre éclairé
    Femme Profil pro
    reconversion en cours
    Inscrit en
    Juillet 2009
    Messages
    637
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : reconversion en cours
    Secteur : Conseil

    Informations forums :
    Inscription : Juillet 2009
    Messages : 637
    Par défaut
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
                    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
    Fichiers attachés Fichiers attachés

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Réponses: 14
    Dernier message: 25/07/2013, 10h29
  2. Réponses: 1
    Dernier message: 05/09/2006, 17h56
  3. requêtes dans un tableau excel!? possible?
    Par flower dans le forum Access
    Réponses: 2
    Dernier message: 12/05/2006, 16h43
  4. Réponses: 7
    Dernier message: 02/05/2006, 11h28
  5. [VBA-E] connaitre le nombre de ligne dans un tableau excel
    Par bigbarbe dans le forum Macros et VBA Excel
    Réponses: 4
    Dernier message: 13/04/2006, 10h03

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo