Automatisation de formules Excel

norbrodwin Messages postés 14 Statut Membre -  
ThauTheme Messages postés 1564 Statut Membre -
Bonjour,
Sur un tableau Excel avec des colonnes de A à V dans la feuille 1, je voudrais créer une macro qui exécute et simultanément les actions suivantes dans la feuille 2 :
- Retirer les doublons
- Garder uniquement les lignes où la colonne G est supérieure ou égale à 30
- Supprimer les lignes où la colonne O = « Anomalie »
Je vous remercie infiniment par avance, sachant que c'est une macro qui me facilitera énormément la vie.
Je compte sur vous les amis ?

9 réponses

  1. ThauTheme Messages postés 1564 Statut Membre 160
     
    Bonjour Norbrodwin, bonjour le forum,

    qu'entends-tu par doublons, les lignes strictement identiques (toutes les cellules des colonnes A à V) ?
    En attendant ta réponse, le code ci-dessous fait le reste de ta requête :

    Sub Macro1()
    Dim O As Object 'déclare la variable O (Onglet)
    Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
    Dim TC As Variant 'déclare la variable TC (Tableau de Cellules)
    Dim PL As Range 'déclare la variable PL (Plage de Lignes)
    Dim I As Integer 'déclare la variable I (Incrément)

    Set O = Sheets("Feuil1") 'définit l'onglet O (à adapter)
    DL = O.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne 1 (=A) de l'onglet O (à adapter à la colonne ayant le plus de lignes éditée)
    Set PL = O.Range("A1") 'initialise la plafe de lignes PL
    TC = O.Range("A1:V" & DL) 'définit le tableau de cellules TC
    For I = 1 To UBound(TC, 1) 'boucle sur toutes les lignes du tableau TC
    'si la cellule en colonne 7 (=G) de la ligne est inférieure à 30, redéfinit la plage de lignes PL
    If TC(I, 7) < 30 Then Set PL = IIf(PL.Cells.Count = 1, O.Rows(I), Application.Union(PL, O.Rows(I)))
    'si la cellule en colonne 15 (=0) de la ligne vaut "Anomalies", redéfinit la plage de lignes PL
    If TC(I, 15) = "Anomalie" Then Set PL = IIf(PL.Cells.Count = 1, O.Rows(I), Application.Union(PL, O.Rows(I)))
    Next I 'prochaine ligne de la boucle
    PL.Delete 'supprime la plage des lignes PL
    End Sub

    0
  2. norbrodwin Messages postés 14 Statut Membre
     
    Tout d'abord merci beaucoup pour ton retour,
    Tu as tout à fait raison pour les doublons :
    Se baser sur la colonne A pour supprimer toutes les lignes ou il y a des boublons sur la colonne A.

    Merci d'avance pour le complement :)

    PS : est il possible d'incorporer ce complement dans le reste du code (pour faire un copier/coller please ;) )
    0
  3. norbrodwin Messages postés 14 Statut Membre
     
    Je précise juste que :
    O : Il s'agit de la colonne O
    les feuilles seront feuille1 et feuille2
    (j'ai tout pris en copier coller = ça n'a pas marché :'(
    0
  4. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  5. ThauTheme Messages postés 1564 Statut Membre 160
     
    Bonjour le fil, bonjour le forum,

    j'avais écrit (à adapter) il me semble...
    En relisant, je réalise que ce n'est pas clair :

    Sur un tableau Excel avec des colonnes de A à V dans la feuille 1, je voudrais créer une macro qui exécute et simultanément les actions suivantes dans la feuille 2 :

    Cette phrase n'a pas de sens...

    Le code complet. Pour l'exécuter sur l'onglet que tu veux, modifie la ligne :

    Set O = Sheets("Feuil1") 'définit l'onglet O (à adapter)

    Sub Macro1()
    Dim O As Object 'déclare la variable O (Onglet)
    Dim LI As Range 'déclare la variable LI (Plage de Lignes)
    Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
    Dim PL As Range 'déclare la variable PL (PLage)
    Dim TC As Variant 'déclare la variable TC (Tableau de Cellules)
    Dim D As Object 'déclare la variable D (Dictionnaire)
    Dim I As Integer 'déclare la variable I (Incrément)
    Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
    Dim PLV As Range 'déclare la variable PLV (PLage Visible)

    Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
    Set O = Sheets("Feuil1") 'définit l'onglet O (à adapter)
    Set LI = O.Range("A1") 'initialise la plage de lignes LI
    DL = O.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne 1 (=A) de l'onglet O (à adapter à la colonne ayant le plus de lignes éditée)
    Set PL = O.Range("A2:V" & DL) 'définit la palge PL
    TC = PL 'définit le tableau de cellules TC
    Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
    For I = 1 To UBound(TC, 1) 'boucle sur toutes les lignes du tableau TC
    D(TC(I, 1)) = "" 'alimente le dictionnaire D
    Next I 'prochaine ligne de la boucle
    TMP = D.keys 'récupère dans le tableau temporaire TMP la liste des élément du dictionnaire D sans doublon
    For I = 0 To UBound(TMP) 'boucle sur tous les éléments du tableau temporaire TMP
    O.Range("A1").AutoFilter Field:=1, Criteria1:=TMP(I) 'filtre en A1 la colonne 1 (=A) de l'onglet O avec TMP(I) comme critère
    Set PLV = PL.SpecialCells(xlCellTypeVisible) 'définit la plage PLV (cellules visibles (non filtrées) de la plage PL)
    If Application.Intersect(PLV, O.Columns(1)).Cells.Count > 1 Then PLV.EntireRow.Delete 'si doublons, supprime la plage PLV
    O.Range("A1").AutoFilter 'supprime le filtre automatique
    Next I 'prochaine élément de la boucle
    DL = O.Cells(Application.Rows.Count, 1).End(xlUp).Row 'redéfinit la dernière ligne éditée DL de la colonne 1 (=A) de l'onglet O (à adapter à la colonne ayant le plus de lignes éditée)
    TC = O.Range("A1:V" & DL) 'définit le tableau de cellules TC
    For I = 2 To UBound(TC, 1) 'boucles sur toutes les lignes du tableau TC (en partant de la seconde)
    'si la cellule en colonne 7 (=G) de la ligne est inférieure à 30, redéfinit la plage de lignes LI
    If TC(I, 7) < 30 Then Set LI = IIf(LI.Cells.Count = 1, O.Rows(I), Application.Union(LI, O.Rows(I)))
    'si la cellule en colonne 15 (=0) de la ligne vaut "Anomalies", redéfinit la plage de lignes LI
    If TC(I, 15) = "Anomalie" Then Set LI = IIf(LI.Cells.Count = 1, O.Rows(I), Application.Union(LI, O.Rows(I)))
    Next I 'prochaine ligne de la boucle
    LI.Delete 'supprime la plage des lignes LI
    Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
    End Sub


    https://www.cjoint.com/?DKelnRZE4sC

    À plus,
    Thautheme
    0
  6. norbrodwin Messages postés 14 Statut Membre
     
    Vraiment désolé de ne pas avoir été claire précédemment. Je te rajoute un fichier sur lequel je voudrai appliquer ma Macro :
    https://www.cjoint.com/?3KeonDVgvk5
    Sur ce fichier, l'idée est de garder la fuil1 intacte mais d'incorporer le résultat de la macro sur la feuil2.
    Voici les conditions de la Macro :
    - Sur la Colonne W (ID_Code) : tu remarqueras que les lignes 2 et 3 comprennent la même valeur (1) idem pour les lignes (9 et 10) qui comprennent la même valeur (8)
    ? Donc avec le dédoublonnage, on ne gardera qu'une seule ligne à la fois (peu importe laquelle)
    - Sur la colonne Z (Délais OFF) on ne gardera que les valeurs supérieures ou égales à 30
    - Sur la colonne AA, on ne gardera que les lignes avec la valeur « Oui »
    Du coup en faisant les manipulations manuellement, résultat sera de 3 lignes. Donc si notre macro tourne bien, le résultat devra être le même.
    0
  7. ThauTheme Messages postés 1564 Statut Membre 160
     
    Bonjour Norbrodwin, bonjour le forum,

    Le code adapté :

    Sub Macro1()
    Dim O1 As Object 'déclare la variable O1 (Onglet 1)
    Dim O2 As Object 'déclare la variable O2 (Onglet 2)
    Dim LI As Range 'déclare la variable LI (Plage de Lignes)
    Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
    Dim PL As Range 'déclare la variable PL (PLage)
    Dim TC As Variant 'déclare la variable TC (Tableau de Cellules)
    Dim D As Object 'déclare la variable D (Dictionnaire)
    Dim I As Integer 'déclare la variable I (Incrément)
    Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
    Dim PLV As Range 'déclare la variable PLV (PLage Visible)

    Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
    Set O1 = Sheets("Feuil1") 'définit l'onglet O1
    Set O2 = Sheets("Feuil2") 'définit l'onglet O2
    O2.Rows.Delete 'supprime des éventuelles anciennes données de l'onglet O2
    O1.UsedRange.Copy O2.Range("A1 ") 'copy le tableau de l'onglet O1 dans l'onglet O2

    Set LI = O2.Range("A1") 'initialise la plage de lignes LI
    DL = O2.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne 1 (=A) de l'onglet O2 (à adapter à la colonne ayant le plus de lignes éditée)
    Set PL = O2.Range("A2:AA" & DL) 'définit la palge PL
    TC = PL 'définit le tableau de cellules TC
    Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
    For I = 1 To UBound(TC, 1) 'boucle sur toutes les lignes du tableau TC
    D(TC(I, 23)) = "" 'alimente le dictionnaire D
    Next I 'prochaine ligne de la boucle
    TMP = D.keys 'récupère dans le tableau temporaire TMP la liste des élément du dictionnaire D sans doublon
    For I = 0 To UBound(TMP) 'boucle sur tous les éléments du tableau temporaire TMP
    O2.Range("A1").AutoFilter Field:=23, Criteria1:=TMP(I) 'filtre en A1 la colonne 23 (=W) de l'onglet O2 avec TMP(I) comme critère
    Set PLV = PL.SpecialCells(xlCellTypeVisible) 'définit la plage PLV (cellules visibles (non filtrées) de la plage PL)
    On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
    Set PLV = PLV.Offset(1, 0).Resize(PLV.Rows.Count - 1, PLV.Columns.Count) 'redéfinit la plage PL en gardant la première ligne (génere une erreur si PLV n'a qu'une seule ligne)
    If Err <> 0 Then 'condition : si une erreur a été générée
    Err.Clear 'efface l'erreur
    GoTo suite 'va a l'étiquette "suite" sans supprimer la plage PLV
    End If 'fin de la condition
    PLV.EntireRow.Delete 'supprime la plage PLV
    suite: 'étiquette
    On Error GoTo 0 'annule la gestion des erreurs
    O2.Range("A1").AutoFilter 'supprime le filtre automatique
    Next I 'prochaine élément de la boucle
    DL = O2.Cells(Application.Rows.Count, 1).End(xlUp).Row 'redéfinit la dernière ligne éditée DL de la colonne 1 (=A) de l'onglet O2 (à adapter à la colonne ayant le plus de lignes éditée)
    TC = O2.Range("A1:AA" & DL) 'redéfinit le tableau de cellules TC
    For I = 2 To UBound(TC, 1) 'boucles sur toutes les lignes du tableau TC (en partant de la seconde)
    'si la cellule en colonne 26 (=Z) de la ligne est inférieure à 30, redéfinit la plage de lignes LI
    If TC(I, 26) < 30 Then Set LI = IIf(LI.Cells.Count = 1, O2.Rows(I), Application.Union(LI, O2.Rows(I)))
    'si la cellule en colonne 27 (=AA) de la ligne est différente de "oui", redéfinit la plage de lignes LI
    If TC(I, 27) <> "oui" Then Set LI = IIf(LI.Cells.Count = 1, O2.Rows(I), Application.Union(LI, O2.Rows(I)))
    Next I 'prochaine ligne de la boucle
    LI.Delete 'supprime la plage des lignes LI
    Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
    End Sub

    0
  8. norbrodwin Messages postés 14 Statut Membre
     
    Merci beaucoup pour ta reponse :)

    J'ai intégré la macro :
    - Le resultat est bien sur la feuil2
    - Ca supprime bien les doublons

    Mais le reste des conditions >30 (Colonne Z), et (Supprimer les lignes "Non" (Colonne AA) n'a pas fonctionné.

    Peux-tu m'aider stp ?
    Merci d'avance.
    0