comparer des cellules dans une colonne Résolu

Question

Bonjour à tous,

je suis débutant en vba et je souhaiterai comparer des cellules dans des colonnes.Je m'explique pour votre compréhension.

Dans la colonne A de la feuille 1 j'ai un identifiant de type Axxx xxxx avec une date en colonne B ensuite dans la colonne A de la feuille 2 j'ai un identifiant de type Axxx xxxx et une date dans la colonne B.
Je souhaiterai chercher l'identifiant de la feuille 1 avec celui de la feuille 2 et recopier en feuille 3 l'identifiant de la feuille 2 avec la nouvelle date de la feuille 2.

J'espère avoir été très explicite.

Merci d'avance pour votre retour.

michel_m · Answer

Bonjour

Les propositions peuvent être très différentes suivant le nombre de lignes

comme on a pas envie de passer du temps à refaire un classeur qui ne conviendrait certainement pas...

Mettre le classeur sans données confidentielles en pièce jointe sur https://www.cjoint.com/
et coller le raccourci  proposé (clic droit) dans le message de réponse
Dans l'attente

Kuartz · Answer

Bonjour,

Ce genre de code devrait convenir :

Sub COMPARATIF()
Dim DLig As Long
Dim DLig2 As Long
DLig = Sheets(1).Range("A2").End(xlDown).Row
DLig2 = Sheets(2).Range("A2").End(xlDown).Row
x = 3
'boucle sur les lignes de Feuil2
For t = 4 To DLig2
' si identifiant existe en feuil 1 on recopie les colonnes en feuil3
If Application.WorksheetFunction.CountIf(Sheets(1).Range("A:A"), Sheets(2).Range("A" & t)) > 0 Then
    x = x + 1
        For k = 1 To 2
        Sheets(3).Cells(x, k) = Sheets(2).Cells(t, k)
        Next
    End If
Next t
'boucle sur les lignes de Feuil1
For t = 2 To DLig
' si identifiant existe en feuil 2  on recopie les colonnes en feuil3
If Application.WorksheetFunction.CountIf(Sheets(2).Range("A:A"), Sheets(1).Range("A" & t)) > 0 Then
    x = x + 1
 For k = 1 To 2
        Sheets(3).Cells(x, k) = Sheets(2).Cells(t, k)
        Next
    End If
Next t

End Sub

Comparer des cellules dans une colonne

2 réponses

Discussions similaires

Newsletters