Comparer deux onglets et supprimer des lignes

sebj9

XLDnaute Nouveau
Bonjour,

Je souhaiterais comparer deux onglets excel. Dans un premier onglet, j'ai une base de données d'un grand nombre d'entreprises.

Dans le deuxième onglet, j'ai juste les entreprises que je veux, j'aimerais donc pourvoir supprimer automatiquement les entreprises du premier onglet qui ne se trouvent pas dans le deuxième.

Comment faire ? Je pense qu'il faut une macro en VBA.

Merci d'avance
 

Theze

XLDnaute Occasionnel
Re : Comparer deux onglets et supprimer des lignes

Bonjour,

Une piste. Essais à faire sur une copie du classeur afin de voir si le résultat est celui souhaité. Adapter les noms de feuilles et les plages (ici, en colonne A pour les deux feuilles) où se trouvent les noms des entreprises. Il faut que les noms soient orthographiés de la même façon dans les deux feuilles (la casse a une importance) :
Code:
Sub Chercher()
    
    Dim Fe_Ref As Worksheet
    Dim Fe_Supprim As Worksheet
    Dim Plage_Ref As Range
    Dim Plage_Supprim As Range
    Dim Cel_Ref As Range
    Dim Cel_Supprim As Range
    Dim Tbl() As Long
    Dim I As Long
    
    'feuille où se trouve les entreprises de référence
    Set Fe_Ref = Worksheets("Feuil1")
    
    'feuille où se trouve les entreprises qui seront supprimées
    Set Fe_Supprim = Worksheets("Feuil2")
    
    'nom des entreprise en colonne A
    With Fe_Ref

        Set Plage_Ref = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
    
    End With
    
    'idem
    With Fe_Supprim

        Set Plage_Supprim = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
    
    End With
    
    'on suppose que l'entreprise n'existe qu'une fois dans la feuille
    'on parcour la plage où doivent être supprimées les entreprises
    'si pas trouvée, on mémorise la ligne dans un tableau
    For Each Cel_Supprim In Plage_Supprim
    
        Set Cel_Ref = Plage_Ref.Find(Cel_Supprim, , xlValues, xlWhole)
        
        If Cel_Ref Is Nothing Then
            
            I = I + 1
            ReDim Preserve Tbl(1 To I)
            Tbl(I) = Cel_Supprim.Row
            
        End If
        
    Next Cel_Supprim
    
    'pour une suppression par le bas de la feuille
    'on tri le tableau en ordre décroissant
    Tri Tbl()
    
    'on supprime les lignes
    For I = 1 To UBound(Tbl)
        
        Fe_Supprim.Rows(Tbl(I)).EntireRow.Delete
        
    Next I
    
End Sub

Sub Tri(Tbl() As Long)

    Dim Tempo
    Dim I As Long
    Dim J As Long
    
            'pour un tri décroissant "<"
            'pour un tri croissant ">"
    For I = 1 To UBound(Tbl) - 1
    
        For J = I + 1 To UBound(Tbl)
        
            If Tbl(I) < Tbl(J) Then
            
                Tempo = Tbl(J)
                Tbl(J) = Tbl(I)
                Tbl(I) = Tempo
                
            End If
            
        Next J
        
    Next I

End Sub

Hervé.
 

sebj9

XLDnaute Nouveau
Re : Comparer deux onglets et supprimer des lignes

Merci,

Mais il y a une erreur, ou j'ai peut-etre mal renseigné quelque chose. J'ai vérifier le nom des feuilles et des colonnes.


For I = 1 To UBound(Tbl) - 1

Il me le met en jaune. le but est donc de supprimer une ligne de la feuille 1 quand il trouve pas l'entreprise dans la feuille 2.

Ci-joint le fichier. C'est peut-être plus simple.

Merci beaucoup

Cordialement
 

Pièces jointes

  • Prospect2.xlsx
    270.4 KB · Affichages: 519

job75

XLDnaute Barbatruc
Re : Comparer deux onglets et supprimer des lignes

Bonjour,

Fichier .xls joint avec cette macro :

Code:
Sub SupprimerLignes()
'Feuil1 et Feuil2 sont les CodeNames des feuilles
Dim plage As Range
Set plage = Feuil1.Range("A2:BH" & Feuil1.[A65536].End(xlUp).Row)
With plage.Columns("BH")
  .FormulaR1C1 = "=MATCH(RC1," & Feuil2.Name & "!C1,0)"
  'tri pour accélérer la suppression
  plage.Sort .Columns, xlAscending, Header:=xlNo
  On Error Resume Next
  'recherche des #N/A et suppression des lignes
  .SpecialCells(xlCellTypeFormulas, 16).EntireRow.Delete
  .ClearContents
End With
End Sub
Edit : la formule utilise MATCH (EQUIV), la casse n'a pas d'importance.

A+
 

Pièces jointes

  • Prospect2(1).xls
    644.5 KB · Affichages: 69
Dernière édition:

sebj9

XLDnaute Nouveau
Re : Comparer deux onglets et supprimer des lignes

Merci Job75

Malheureusement j'ai essayé de rajouter des lignes dans la feuil1 pour voir si la Macro les supprimerais vu qu'elles ne sont pas dans la feuil2 mais cela ne fonctionne pas quand je fais mes tests en bas de page.

Merci quand même de ton aide.
 

job75

XLDnaute Barbatruc
Re : Comparer deux onglets et supprimer des lignes

Re,

J'ai ajouté "zzz" en A971 de Feuil1, la ligne est bien supprimée :confused:

Mais bien sûr le tableau est délimité par la dernière cellule en colonne A.

Si vous mettez des valeurs en dessous dans d'autres colonnes, elles ne seront pas supprimées...

Edit : attention, il y avait une faute d'orthographe dans le code de la macro, j'ai corrigé à 16h17...

A+
 
Dernière édition:

job75

XLDnaute Barbatruc
Re : Comparer deux onglets et supprimer des lignes

Re,

Un complément important.

Si le nom de Feuil2 comporte des espaces il faut dans la formule mettre le nom entre quotes ' :

Code:
.FormulaR1C1 = "=MATCH(RC1,'" & Feuil2.Name & "'!C1,0)"
Fichier (2).

A+
 

Pièces jointes

  • Prospect2(2).xls
    644.5 KB · Affichages: 69

Discussions similaires

Statistiques des forums

Discussions
311 709
Messages
2 081 756
Membres
101 812
dernier inscrit
trufu