RechercheV via macro

[Tristan]

Bonsoir le forum,

Mes talents en macro étant limités, je sollicite vos lumières sur le point suivant :

J'ai 2 listes de données en colonne A et B (cf ci-joint).
Je souhaite via une macro placer en colonne C les données existant dans A mais pas dans B.
Et placer en colonne D les données existant dans B mais pas dans A.

Merci par avance si quelqu'un pourrait m'éclairer.
[file name=Exemple_20051028192307.zip size=1462]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/Exemple_20051028192307.zip[/file]

 

[FabriceLeManuzien]

Bonsoir à tous,

Une solution :

Option Explicit
Dim DernièreLigneColA As Long
Dim DernièreLigneColB As Long
Dim NoLigneColA As Long
Dim NoLigneColB As Long
Dim NoLigneColC As Long
Dim NoLigneColD As Long
Dim ExisteDansColA As Boolean
Dim ExisteDansColB As Boolean

Sub Recherche()

DernièreLigneColA = Range('A65536').End(xlUp).Row
DernièreLigneColB = Range('B65536').End(xlUp).Row
NoLigneColC = 3
NoLigneColD = 3

For NoLigneColA = 3 To DernièreLigneColA
ExisteDansColB = False
For NoLigneColB = 3 To DernièreLigneColB

If Cells(NoLigneColA, 1).Value = Cells(NoLigneColB, 2).Value Then
ExisteDansColB = True
Exit For
End If
Next
If ExisteDansColB = False Then Call AjouteColC
Next

For NoLigneColB = 3 To DernièreLigneColB
ExisteDansColA = False
For NoLigneColA = 3 To DernièreLigneColA

If Cells(NoLigneColB, 2).Value = Cells(NoLigneColA, 1).Value Then
ExisteDansColA = True
Exit For
End If
Next
If ExisteDansColA = False Then Call AjouteColD
Next



End Sub

Private Sub AjouteColC()
Cells(NoLigneColC, 3).Value = Cells(NoLigneColA, 1).Value
NoLigneColC = NoLigneColC + 1
End Sub

Private Sub AjouteColD()
Cells(NoLigneColD, 4).Value = Cells(NoLigneColB, 2).Value
NoLigneColD = NoLigneColD + 1
End Sub

 

[Tristan]

Bonsoir et bravo Fabrice,

Ta macro fonctionne à merveille et je te remercie d'avoir pris le
temps de répondre si vite.

A bientôt.

 

[Charly2]

Bonsoir Tristan et Fabrice, bonsoir le forum

Une autre manière de procéder avec Find :

Option Explicit

Sub Recherche()
'
Dim CelluleRecherche As Range
Dim CelluleTrouvee As Range
Dim CelluleIciMaisPasLa As Range
Dim LigneActuelle As Long
'
Set CelluleIciMaisPasLa = Range('C3')
Range('B:B').Select
For Each CelluleRecherche In Range('A3', Range('A65536').End(xlUp))
If Selection.Find(CelluleRecherche.Value) Is Nothing Then
CelluleIciMaisPasLa.Value = CelluleRecherche.Value
Set CelluleIciMaisPasLa = CelluleIciMaisPasLa.Offset(1, 0)
End If
Next

Set CelluleIciMaisPasLa = Range('D3')
Range('A:A').Select
For Each CelluleRecherche In Range('B3', Range('B65536').End(xlUp))
If Selection.Find(CelluleRecherche.Value) Is Nothing Then
CelluleIciMaisPasLa.Value = CelluleRecherche.Value
Set CelluleIciMaisPasLa = CelluleIciMaisPasLa.Offset(1, 0)
End If
Next
Range('A1').Select
End Sub

Amicalement
Charly