Macro qui compare 2 colonnes de 2 feuilles excel et qui supprime les différences.

Version imprimable

Voir 40 message(s) de cette discussion en une page

22/11/2010, 18h51
MarcelG

Table

Je confirme Il faut bien séparer la colonne c

Pour bien se comprendre, Ci-joint ton fichier modifié avec macro adaptée.

Bonsoir
Mettre tout dans une seule feuille n'es pas recommandé vu que tu vas supprimer des lignes

Dans Feuil1, Colonne A tu mets tes données brutes. Remarque que tu n'auras pas besoin de la colonne B correspondant aux domaines des adresses de la colonne A
Dans Feuil2, Colonne A, la liste de tes domaines (Top de domaines)
Ce code fera l'affaire (testé)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub Macro()
Dim i As Long, LastLig As Long
Dim c As Range
 
Application.ScreenUpdating = False
With Sheets("Feuil1")
    LastLig = .Cells(Rows.Count, 1).End(xlUp).Row
    For i = LastLig To 2 Step -1
        If UBound(Split(.Range("A" & i).Value, "@")) > 0 Then
            Set c = Sheets("Feuil2").Range("A:A").Find(Split(.Range("A" & i).Value, "@")(1), lookat:=xlWhole)
            If c Is Nothing Then .Rows(i).Delete
        End If
    Next i
End With
End Sub

Ou bien

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub Macro2()
Dim i As Long, LastLig As Long
Dim c As Range
Dim Pos As Integer
 
Application.ScreenUpdating = False
With Sheets("Feuil1")
    LastLig = .Cells(Rows.Count, 1).End(xlUp).Row
    For i = LastLig To 2 Step -1
        Pos = InStr(.Range("A" & i).Value, "@")
        If Pos > 0 Then
            Set c = Sheets("Feuil2").Range("A:A").Find(Mid(.Range("A" & i).Value, Pos + 1), lookat:=xlWhole)
            If c Is Nothing Then .Rows(i).Delete
        End If
    Next i
End With
End Sub

23/11/2010, 17h06
a.saussois

Génial !!!

Merci bcp, MarcelG.

Je vais chercher maintenant comment répartir sur une autre feuille les résultats par colonne, un autre défi :)

Cordialement,
Antoine.

Inverser, ne prendre que les adresses qui match pas.

Bonjour, comment est il possible de faire l'inverse ? et garder uniquement les lignes différentes ??

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Public Sub essai()
Dim colonne As Range
Application.ScreenUpdating = False
Max = Sheets("mafeuille").Range("A" & Rows.Count).End(xlUp).Row
With Sheets("base")
    Set colonne = .Range(.Range("A1"), .Range("A" & Rows.Count).End(xlUp))
End With
For i = Max To 1 Step -1
    If IsError(Application.Match(Sheets("mafeuille").Cells(i, 2), colonne, 0)) Then Sheets("mafeuille").Cells(i, 2).EntireRow.Delete
Next
Set colonne = Nothing
End Sub

29/11/2010, 17h35
a.saussois

Marche pas
Code:

1 2 For i = Max To 1 Step -1 If IsError(Application.Match(Sheets("traitement").Cells(i, 2), colonne, 0)) Then Sheets("traitement").Cells(i, 2).EntireRow.Delete
quel parametre je peux passer a la place de : "EntireRow.Delete"

pour déplacer les données dans une autre colonne.

Cordialement,
Antoine

Voir 40 message(s) de cette discussion en une page