Supprimer la ligne si la donnée est la même dans un autre fichier Excel

Le 05/01/2021 à 10:36

Bonjour

Meilleur voeux pour cette nouvelle année !

Je vous expose mon problème :

J'ai deux fichiers excel (ceux que je vous mets en pj sont des exemples). le premier est une extraction de données et la seconde une base de données (de plusieurs feuilles) évolutive que j'alimente moi même.

Ce que j'aimerais faire grâce au VBA serait de supprimer sur mon fichier d'extraction les lignes si il y a dans ma base de données la donnée renseignée.

Exemple : Sur les fichiers que je vous ai donnés ça serait de supprimer la ligne dans mon fichier "Extraction notes élèves" si le nom d'un élève est présent dans le fichier "base de données élèves".

Actuellement je fais une recherche v, puis je supprime les données similaires. Mais cette démarche est énormément chronophage...

J'ai aussi créé un code VBA qui me permet de coller les données de mes différentes feuilles pour ensuite les trier. Mais ce n'est pas la bonne méthode ...

12extraction-notes-eleves.zip (470.73 Ko)

12base-de-donnees-eleves.xlsx (17.69 Ko)

PS : Mes deux fichiers sont beaucoup plus volumineux que ceux que je vous ai mis en pj.

Le 05/01/2021 à 11:45

Bonjour Mattod, bonjour le forum,

En pièce jointe ton fichier modifié (devenu xlsm à cause de la macro). Si les deux classeurs se trouvent dans le même dossier, ouvre uniquement celui-ci (la macro ouvrira l'autre) et lance la macro. Sinon ouvre les deux avant de lancer la macro...

Le code :

Option Explicit

Sub Macro1()
Dim CB As Workbook 'déclare la variable CB (Classeur Base)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim CE As Workbook 'déclare la variable CE (Classeur Extaction)
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim OE As Worksheet 'déclare la variable OE (Onglet Extraction)
Dim TVB As Variant 'déclare la variable TVB (Tableau des Valeurs Base)
Dim TVE As Variant 'déclare la variable TVE (Tableau des Valeurs Extraction)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set CB = ThisWorkbook 'définit le classeur base CB
CA = CB.Path & "\" 'définit la chemin d'accès CA
On Error Resume Next 'gestion des erreurs en cas d'erreur passe à la ligne suivante
Set CE = Workbooks("extraction-notes-eleves.xlsx") 'définit le classeur d'extraction CE (génère une erreur si ce classeur n'est pas ouvert)
If Err > 0 Then 'condition : si une erreur a été générée
    Err.Clear 'supprime l'erreur
    Set CE = Application.Workbooks.Open(CA & "extraction-notes-eleves.xlsx") 'définit le classeur d'extraction CE en l'ouvrant
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
Set OE = CE.Worksheets("NOTES") 'définit l'onglet d'extraction OE
TVE = OE.Range("A1").CurrentRegion 'définit la tableau des valeurs extraction
For Each O In CB.Sheets 'boucle 1 : sur tous les onglets O du classeur base CB
    'condition : si le nom de O est différent de ...
    If O.Name <> "xl_DCF_History" And O.Name <> "Classified as UnClassified" Then
        TVB = O.Range("A1").CurrentRegion 'définit la tableau des valeurs base TVB
        For J = 2 To UBound(TVB, 1) 'boucle 2 : sur toutes les lignes J du tableau des valeurs TVB (en partant de la seconde)
            For I = UBound(TVE, 1) To 2 Step -1 'boucle 3 inversée : sur toutes les lignes I du tableau des valeurs TVE (jusqu'à la la seconde)
                If TVB(J, 1) = TVE(I, 1) Then OE.Rows(J).Delete 'si la donnée ligne J de TVB est égale à la donnée ligne I de TVE, supprime la ligne J de l'onglet OE
            Next I 'prochaine ligne de la boucle 3
        Next J 'prochaine ligne de la boucle 2
    End If 'fin de la condition
Next O 'prochain onglet de la boucle 1
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
MsgBox "Données traitées !" 'message
End Sub

Le fichier :

11base-de-donnees-eleves.xlsm (30.08 Ko)

Le 05/01/2021 à 11:53

Bonjour

Bonjour à tous

Une variante

8extraction-notes-eleves-v1.zip (484.50 Ko)

6base-de-donnees-eleves.xlsx (22.81 Ko)

Bye !

Le 05/01/2021 à 15:04

Merci à tous les deux pour votre rapidité !

@thautème ton code fonctionne très bien cependant je n'arrive pas à l'adapter à mon fichier de travail. J'ai essayé de le convertir mais j'obtiens ce message d'erreur "run time error 13 missmatch". J'ai changé le A1 en B1 puisque c'est sur la colonne B que je souhaite supprimer.

Quand je lance la macro mon fichier apparait (c'est déjà un bon début haha), je pense que j'ai fait une erreur dans ligne vers la fin (je ne maitrise pas bien le langage)

Est ce que tu vois où j'ai pu faire l'erreur ?

Sub Macro1()
Dim CB As Workbook 'déclare la variable CB (Classeur Base)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim CE As Workbook 'déclare la variable CE (Classeur Extaction)
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim OE As Worksheet 'déclare la variable OE (Onglet Extraction)
Dim TVB As Variant 'déclare la variable TVB (Tableau des Valeurs Base)
Dim TVE As Variant 'déclare la variable TVE (Tableau des Valeurs Extraction)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set CB = ThisWorkbook 'définit le classeur base CB
CA = CB.Path & "\" 'définit la chemin d'accès CA
On Error Resume Next 'gestion des erreurs en cas d'erreur passe à la ligne suivante
Set CE = Workbooks("Export.xls") 'définit le classeur d'extraction CE (génère une erreur si ce classeur n'est pas ouvert)
If Err > 0 Then 'condition : si une erreur a été générée
    Err.Clear 'supprime l'erreur
    Set CE = Application.Workbooks.Open(CA & "Export.xls") 'définit le classeur d'extraction CE en l'ouvrant
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
Set OE = CE.Worksheets("Export Sheet") 'définit l'onglet d'extraction OE
TVE = OE.Range("B1").CurrentRegion 'définit la tableau des valeurs extraction
For Each O In CB.Sheets 'boucle 1 : sur tous les onglets O du classeur base CB
    'condition : si le nom de O est différent de ...
    If O.Name <> "xl_DCF_History" And O.Name <> "Classified as UnClassified" Then
        TVB = O.Range("B1").CurrentRegion 'définit la tableau des valeurs base TVB
        For J = 2 To UBound(TVB, 2) 'boucle 2 : sur toutes les lignes J du tableau des valeurs TVB (en partant de la seconde)
            For I = UBound(TVE, 2) To 2 Step -1 'boucle 3 inversée : sur toutes les lignes I du tableau des valeurs TVE (jusqu'à la la seconde)
                If TVB(J, 2) = TVE(I, 2) Then OE.Rows(J).Delete 'si la donnée ligne J de TVB est égale à la donnée ligne I de TVE, supprime la ligne J de l'onglet OE
            Next I 'prochaine ligne de la boucle 3
        Next J 'prochaine ligne de la boucle 2
    End If 'fin de la condition
Next O 'prochain onglet de la boucle 1
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
MsgBox "Données traitées !" 'message
End Sub

Le 05/01/2021 à 15:48

Re,

1- Tu as changé où ?!. La flemme de tout relire...
2- Le fichier qui va bien. Si tu veux que je comprennes...

Le 05/01/2021 à 16:07

@gmb encore merci !

Comme pour thauthème, ta macro fonctionne très bien, mais je n'arrive pas à l'adapter à mes fichiers.

En effet dans mon fichier les éléments communs entre la bdd et le fichier extrait sont sur la colonne B.

Comme tu peux le voir j'ai modifier un peu le code mais mon manque d'expériece ne me permet pas de le faire correctement. Pourrais tu m'inquer les démarches à suivre pour le modifier ?

Je vous mets en pj, des fichiers qui ressemblent un peu plus à ceux dont je me retrouve confrontés.

Le concept est le même je voudrais supprimer la ligne dans mon fichier "Extraction notes élèves" si le nom d'un élève est présent dans le fichier "BDD" et plus précisement dans les onglets données 1, 2, 3 et 4. (après je peux supprimer les autres onglets si c'est plus simple).

Cordialement

Mattod

5bdd.xlsx (38.32 Ko)

6extraction-notes-eleves.zip (506.98 Ko)

Option Explicit

Dim w As Workbook, fa As Worksheet, f As Worksheet, dico As Object
Dim tablo, tabloR()
Dim i&, j&, k&

Sub Supprimer()

    Set fa = ActiveSheet
    Set dico = CreateObject("Scripting.Dictionary")

    For Each w In Workbooks
        If w.Name = "mabdd.xls" Then
            Exit For
        End If
    Next w
    On Error Resume Next
    Set w = Workbooks(w.Name)
    If Err.Number <> 0 Then
        MsgBox "Le fichier ''mabdd.xls'' doit être ouvert.'',16"
        Exit Sub
    End If

    For Each f In w.Worksheets
        If f.Range("B1") = "Export Sheet" Then
            tablo = f.Range("B1").CurrentRegion
            For i = 2 To UBound(tablo, 2)
                dico(tablo(i, 2)) = ""
            Next i
        End If
    Next f

    tablo = fa.Range("B1").CurrentRegion
    k = 0
    For i = 2 To UBound(tablo, 2)
        If Not dico.exists(tablo(i, 2)) Then
            ReDim Preserve tabloR(1 To UBound(tablo, 2), 1 To k + 1)
            For j = 1 To UBound(tablo, 2)
                tabloR(j, 1 + k) = tablo(i, j)
            Next j
            k = k + 1
        End If
    Next i

    fa.Range("B1").CurrentRegion.Offset(1, 0).ClearContents
    fa.Range("B1").Resize(UBound(tabloR, 2), UBound(tablo, 2)) = Application.Transpose(tabloR)
End Sub

Le 05/01/2021 à 16:22

@ThauThème

ci-dessous les modifs : (j'ai suppr tes commentaires pour que tu puisses voir plus rapidement les miens)

Sub Macro1()
Dim CB As Workbook 
Dim CA As String 
Dim CE As Workbook 
Dim O As Worksheet 
Dim OE As Worksheet 
Dim TVB As Variant 
Dim TVE As Variant
Dim I As Integer 
Dim J As Integer 

Application.ScreenUpdating = False 
Set CB = ThisWorkbook 
CA = CB.Path & "\" 
On Error Resume Next 
Set CE = Workbooks("Export.xls") 'définit le classeur d'extraction CE (j'ai donc mis mon classeur)
If Err > 0 Then 'condition : si une erreur a été générée
    Err.Clear 'supprime l'erreur
    Set CE = Application.Workbooks.Open(CA & "Export.xls") 'définit le classeur d'extraction CE en l'ouvrant (j'ai donc mis mon classeur)
End If 
On Error GoTo 0 
Set OE = CE.Worksheets("Export Sheet") 'définit l'onglet d'extraction OE (j'ai donc mis mon classeur)
TVE = OE.Range("B1").CurrentRegion 'définit la tableau des valeurs extraction (j'ai donc mis la colonne souhaitée ici B1)
For Each O In CB.Sheets 

    If O.Name <> "xl_DCF_History" And O.Name <> "Classified as UnClassified" Then
        TVB = O.Range("B1").CurrentRegion 'définit la tableau des valeurs base TVB (j'ai donc mis la colonne souhaitée ici B1)
        For J = 2 To UBound(TVB, 2) 'j'ai mis (TVB, 2) puisque je souhaite atteindre la colonne B
            For I = UBound(TVE, 2) To 2 Step -1 'j'ai mis (TVB, 2) puisque je souhaite atteindre la colonne B
                If TVB(J, 2) = TVE(I, 2) Then OE.Rows(J).Delete 'j'ai mis (TVB, 2) puisque je souhaite atteindre la colonne B
            Next I 
        Next J 
    End If 
Next O 
Application.ScreenUpdating = True 
MsgBox "Données traitées !" 
End Sub

Concernant les fichiers, je te mets en pj, des fichiers qui ressemblent un peu plus à ceux dont je me retrouve confrontés.

5extraction-notes-eleves.zip (506.98 Ko)

5bdd.xlsx (38.32 Ko)

Le 05/01/2021 à 19:44

Bonjour à tous

Nouvelle version.

10extraction-notes-eleves-v2.zip (522.06 Ko)

12bdd.xlsx (43.13 Ko)

Bye !

Le 06/01/2021 à 14:58

Salut @gmb, Meric pour ta reponse !

Cependant le code ne fonctionne pas quand je l'adapte à mes fichiers ... il n'y a aucune lignes qui est supprimmées...