comparer 2 colonnes et ecrire les differences dans une feuille

yves03

XLDnaute Occasionnel
Bonjour à tous,

J'aurais aimé pouvoir comparer 2 colonnes, colonne A et colonne B et copier sur une autre feuille les cellules qui sont presentent dans la colonne A mais pas dans la colonne B
En VBA si possible, car les feuilles sont supprimées et recreer frequement.
Merci d'avance.
:)
 

mécano41

XLDnaute Accro
Re : comparer 2 colonnes et ecrire les differences dans une feuille

Bonjour,

Avec les valeurs à comparer dans les colonnes A et B de Feuil1 et les valeurs copiées dans la colonne A de Feuil2, j'ai essayé ceci que tu peux mettre dans un module :
Code:
 Option Explicit

Sub CopieSiCorrespond()
Dim Cpt As Long
Dim PosDansA As Variant
Dim Ligne As Long

Feuil2.Range("A:A").Clear
Ligne = 1
For Cpt = 1 To Feuil1.Range("B65536").End(xlUp).Row
    PosDansA = Application.Match(Feuil1.Range("B" & Cpt).Value, Feuil1.Range("A:A"), 0)
    If IsNumeric(PosDansA) Then
        Feuil2.Range("A" & Ligne).Value = Range("A1").Offset(PosDansA - 1, 0).Value
        Feuil2.Range("A" & Ligne).Font.ColorIndex = 3        
        Ligne = Ligne + 1
    End If
Next Cpt
End Sub

NOTA :il peut y avoir des doublons

NOTA 2 : si les colonnes A et B sont de longueurs très différentes, il vaut mieux mettre la plus courte pour faire la boucle : ici c'est B. Si c'était A, il faudrait inverser les lettres de colonnes partout.

Cordialement
 
Dernière édition:

mécano41

XLDnaute Accro
Re : comparer 2 colonnes et ecrire les differences dans une feuille

La même chose mais sans doublon (que les doublons se trouvent initialement en A ou en B)

Code:
Option Explicit

Sub CopieSiCorrespond()
Dim Cpt1 As Long
Dim Cpt2 As Long
Dim PosDansA As Variant
Dim Ligne As Long

Application.ScreenUpdating = False
Feuil2.Range("A:A").Clear
Ligne = 1
For Cpt1 = 1 To Feuil1.Range("B65536").End(xlUp).Row
    PosDansA = Application.Match(Feuil1.Range("B" & Cpt1).Value, Feuil1.Range("A:A"), 0)
    If IsNumeric(PosDansA) Then
        For Cpt2 = 1 To Feuil2.Range("A65536").End(xlUp).Row
            If Not (IsNumeric(Application.Match(Feuil1.Range("A1").Offset(PosDansA - 1, 0).Value, Feuil2.Range("A:A"), 0))) Then
                Feuil2.Range("A" & Ligne).Value = Feuil1.Range("A1").Offset(PosDansA - 1, 0).Value
                Feuil2.Range("A" & Ligne).Font.ColorIndex = 3
                Ligne = Ligne + 1
            End If
        Next Cpt2
    End If
Next Cpt1
Application.ScreenUpdating = True
End Sub
 
Dernière édition:

mécano41

XLDnaute Accro
Re : comparer 2 colonnes et ecrire les differences dans une feuille

Merci beaucoup, ça fonctionne.
Par contre est il possible de copier en rouge les valeurs qui sont copiées sur la feuille 2
Merci d'avance

Oui, je viens d'ajouter une ligne pour cela dans chacun des fichiers.

et j'ajoute aussi un effacement de la colonne réceptrice pour le cas où tu lancerais alors que la colonne est déjà remplie (il resterait des éléments précédents)
 

rabiet

XLDnaute Nouveau
Re : comparer 2 colonnes et ecrire les differences dans une feuille

Bonjour,

je fais un petit up sur ce sujet car j'ai exactement le même pb que yves03

Bonjour à tous,
J'aurais aimé pouvoir comparer 2 colonnes, colonne A et colonne B et copier sur une autre feuille les cellules qui sont présentent dans la colonne A mais PAS dans la colonne B
En VBA si possible, car les feuilles sont supprimées et recreer frequement.
Merci d'avance.
:)

Or la solution proposée ne répond pas au pb. Elle donne en feuil2 les valeurs qui sont dans la colonne A ET dans la colonne B.

Si qqn pouvait m'indiquer comme faire pour répondre au pb posé, ce serait bien sympa.

@+

CR
 

Pièces jointes

  • CopieSiDifferent.xls
    29 KB · Affichages: 73
  • CopieSiDifferent.xls
    29 KB · Affichages: 61
  • CopieSiDifferent.xls
    29 KB · Affichages: 61
Dernière édition:

mécano41

XLDnaute Accro
Re : comparer 2 colonnes et ecrire les differences dans une feuille

Bonsoir,

Le code pour ne prendre que ce qui est seulement en colonne A.

Avec doublons dans le résultat :

Code:
Option Explicit

Sub CopieSiCorrespond()
Dim Cpt As Long
Dim PosDansB As Variant
Dim Ligne As Long

Application.ScreenUpdating = False
Feuil2.Range("A:A").Clear
Ligne = 1
For Cpt = 1 To Feuil1.Range("A65536").End(xlUp).Row                                                            ' Pour toutes les lignes de la colonne A
    PosDansB = Application.Match(Feuil1.Range("A" & Cpt).Value, Feuil1.Range("B:B"), 0)         ' Recherche la position dans B de la valeur trouvée dans A à la ligne Cpt1
    If Not (IsNumeric(PosDansB)) Then                                                                                     ' Si l'on ne trouve rien
        Feuil2.Range("A" & Ligne).Value = Range("A1").Offset(Cpt - 1, 0).Value                             ' On l'écrit
        Feuil2.Range("A" & Ligne).Font.ColorIndex = 3                                                                ' en rouge, dans la colonne A de la feuille 2
        Ligne = Ligne + 1
    End If
Next Cpt
Application.ScreenUpdating = True
End Sub

Sans doublon dans le résultat :

Code:
Option Explicit

Sub CopieSiCorrespond()
Dim Cpt1 As Long
Dim Cpt2 As Long
Dim PosDansB As Variant
Dim Ligne As Long

Application.ScreenUpdating = False
Feuil2.Range("A:A").Clear
Ligne = 1
For Cpt1 = 1 To Feuil1.Range("A65536").End(xlUp).Row                                                            ' Pour toutes les lignes de la colonne A
    PosDansB = Application.Match(Feuil1.Range("A" & Cpt1).Value, Feuil1.Range("B:B"), 0)        ' Recherche la position dans B de la valeur trouvée dans A à la ligne Cpt1
    If Not (IsNumeric(PosDansB)) Then                                                                                      ' Si l'on ne trouve rien
        For Cpt2 = 1 To Feuil2.Range("A65536").End(xlUp).Row                                                    ' On scrute la feuille 2 pour voir si existe déja dans la colonne A
            If Not (IsNumeric(Application.Match(Feuil1.Range("A1").Offset(Cpt1 - 1, 0).Value, Feuil2.Range("A:A"), 0))) Then      ' Si pas trouvé
                Feuil2.Range("A" & Ligne).Value = Range("A1").Offset(Cpt1 - 1, 0).Value                     ' On l'écrit
                Feuil2.Range("A" & Ligne).Font.ColorIndex = 3                                                          ' en rouge, dans la colonne A de la feuille 2
                Ligne = Ligne + 1
            End If
        Next Cpt2
    End If
Next Cpt1
Application.ScreenUpdating = True
End Sub

A vérifier !

Cordialement
 

Discussions similaires

Statistiques des forums

Discussions
312 393
Messages
2 087 961
Membres
103 686
dernier inscrit
maykrem