Supprimer certaines cellules

soliste65 Messages postés 1 Date d'inscription   Statut Membre Dernière intervention   -  
cousinhub29 Messages postés 1074 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour,
Je cherche en vain réponse à mon problème, j'espère que vous pourrez m'aider et je vous en remercie déjà.
J'ai deux fichiers excel remplis en colonne A d'adresses mails. Le 1er comporte environ 10.000 références, le second une centaine.
Certaines de adresses mails du petit fichier sont comprises dans le grand et il me faut les supprimer du grand.
Autrement dit, il me faut chercher une par une dans le grand fichier si les adresses du petit y sont et si c'est le cas, les supprimer.
Je suis en train de le faire à la main, mais comme j'ai à faire la même opération sur une centaine de fichiers, c'est inhumain :((

Merci à vous de votre aide
A voir également:

2 réponses

Réponse 1 / 2
via55 Messages postés 14512 Date d'inscription   Statut Membre Dernière intervention   2 746
 
Bonjour

Avec une petite macro à mettre dans le Worksheet de la Feuille 1 si le grand fichier est en Feuille 1 et le petit en Feuille 2

Sub doublons()
d1 = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
d2 = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row
For n = 1 To d2
For t = 1 To d1
If Sheets(1).Range("A" & t).Value = Sheets(2).Range("A" & n).Value Then Sheets(1).Range(t & ":" & t).Delete: Exit For
Next t
Next n
End Sub

Cdlmnt
0
eriiic Messages postés 24603 Date d'inscription   Statut Contributeur Dernière intervention   7 276
 
Bonjour via,

Il faudrait plutôt utiliser :
For n = d2 to 1 step - 1
pour éviter que des lignes ne soient pas traitées suite à une suppression (toutes remontent d'un cran, et tu passes quand même à la suivante).
Et il est possible d'utiliser la méthode .find pour éviter la 2nde boucle.
Pas les moyens de me pencher dessus plus, désolé ;-)

eric
0
via55 Messages postés 14512 Date d'inscription   Statut Membre Dernière intervention   2 746
 
Bonjour eric
Excellente remarque comme d'hab! oui je suis allé un peu vite !
En suivant tes conseils voilà une macro plus adaptée :

Sub doublons()
' initialisation variables
Dim Trouve As Range, Plage As Range
Dim ValeurCherchee As String, AdresseTrouvee As String

' reperage de la dernière ligen non vide en feuille 2
d2 = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row

'boucle de la derniere ligne à la premiere de feuille 2
For n = d2 To 1 Step -1

' que rechercher
ValeurCherchee = Sheets(2).Range("A" & n).Value
'plage où rechercher
Set Plage = Sheets(1).Columns(1)

'recherche de la valeur exacte
Set Trouve = Plage.Cells.Find(what:=ValeurCherchee, LookAt:=xlWhole)

' Si pas trouvé :
If Trouve Is Nothing Then
p = 0
' Si trouvé :
Else
p = 1 '1 pour compabiliser les suppressions effectuées
AdresseTrouvee = Trouve.Address ' adresse de la correspondance trouvée
Sheets(1).Range(AdresseTrouvee).Delete 'effacement de la correspondance
End If
' nombre de suppressions effectuées est augmenté de 0 ou 1 selon résultat
nb = nb + p

Next n

' message indiquant le nombre de suppressions
MsgBox (nb & " adresses effacées")

'RAZ des variables
Set Plage = Nothing
Set Trouve = Nothing

End Sub

Cdlmnt
0
eriiic Messages postés 24603 Date d'inscription   Statut Contributeur Dernière intervention   7 276
 
Finalement je me demande si c'est moi qui n'avais pas lu un trop trop en diagonale :-s
Vu que tu balayais sheets(2) pour supprimer dans sheets(1) (je pensais que tu balayais sheets(1)) sans doute que ce n'était pas pas si mauvais. Mes excuses :-)
Bon l'inverse ne gène pas, et le .find reste un plus bien sûr.

eric
0
Réponse 2 / 2
cousinhub29 Messages postés 1074 Date d'inscription   Statut Membre Dernière intervention   361
 
Bonsoir,

Une autre solution, via un filtre élaboré...

Il faut tout d'abord que le titre soit identique dans les 2 onglets (cellule A1 dans mon code....) 

Sub Macro1()
Dim Plg As Range
With Sheets("Feuil2")
    If .Range("A1").Value <> Sheets("Feuil1").Range("A1").Value Then
        MsgBox "Le Titre doit être identique"
        Exit Sub
    End If
    Set Plg = .Range("A1:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
End With
With Sheets("Feuil1")
    .Range("A1:A" & .Cells(Rows.Count, 1).End(xlUp).Row).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Plg
    If MsgBox("Etes vous sûr?", vbYesNo) = vbYes Then
        .Range("_FilterDataBase").Offset(1, 0).Resize(.Range("_FilterDataBase"). _
            Rows.Count - 1).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
    Else
        MsgBox "Annulé"
    End If
   .ShowAllData
End With
End Sub

C'était juste pour donner une autre solution.

Bonne fin de W-E
0