Indice VBA excel

Question

Bonjour,

Je travaille actuellement sur Excel et je souhaiterais développer un code VBA me permettant de comparer deux colonnes A situées sur des onglets différents (N et N-1) dans un même classeur afin de déterminer ce qui à été ajouté ou supprimer.

Les entêtes de colonnes A  sont identiques ainsi que les chaînes de caractères à comparer.

l'idée serait de créer une nouvelle colonne en y incluant "1" si la cellule existe dans les deux onglets, "2" si la cellule existe uniquement pour N-1 et "3" si la cellule existe uniquement dans N.

Je sais que le topic à été beaucoup traité, cependant, je n'arrive pas à trouver des ressources suffisantes.

l'Objectif pour moi ensuite étant de pouvoir faire le tri avec cette macro : 

Sub tri_doublon()

Dim Rw As Range
Dim Ligne As Long
Dim derli As Variant
Dim r As Variant

' Sélection des données 
Sheets("N").Select
ActiveCell.SpecialCells(xlLastCell).Select
Range(Selection, Cells(1)).Select

' Boucle qui copie dans une deuxième feuille de calcul

For Each Rw In Selection.Rows

Ligne = Rw.Row

If Rw.Cells(1, 1).Value = "1" Then
Rw.Copy Destination:=Worksheets("Feuil1").Cells(Ligne, 1)
End If

Next Rw

For Each Rw In Selection.Rows

Ligne = Rw.Row

If Rw.Cells(1, 1).Value = "2" Then
Rw.Copy Destination:=Worksheets("Feuil2").Cells(Ligne, 1)
End If

Next Rw

Serait-il possible d'obtenir un soutien technique de votre part ?

Très cordialement


Configuration: Windows XP / Internet Explorer 6.0

madeliocustom · Answer

Bonjour,

voici du code qui fait ce que tu veux a adapter tout de meme en fonction de la repartition de tes listes de données dans tes feuilles excel, et en fonction des codes "1", "2" et "3" que tu souhaites en sortie, car le code ci-dessous construit une nouvelle liste avec les données qui sont dans la deuxieme liste mais pas dans la premiere.

----------------------------------------

Dim ligneparcourslisteexistante As Integer
Dim ligneparcourslistenouvelle As Integer
Dim lignedebut As Integer
Dim lignefinlisteexistante As Integer
Dim lignefinlistenouvelle As Integer
Dim lignefinlisteaajouter As Integer
Dim ligneajout As Integer
Dim existedeja As Integer

Dim colonnelisteexistante As Integer
Dim colonnelistenouvelle As Integer
Dim colonnelisteaajouter As Integer

MsgBox "Demarrage du comparateur de liste"

'debut init
lignedebut = 4
ligneajout = 4
existedeja = 0

colonnelisteexistante = 2
colonnelistenouvelle = 3
colonnelisteaajouter = 4

lignefinlistenouvelle = lignedebut
Do While ActiveWorkbook.Worksheets("listes").Cells(lignefinlistenouvelle, colonnelistenouvelle).Value <> ""
lignefinlistenouvelle = lignefinlistenouvelle + 1
Loop
ligneparcourslistenouvelle = lignefinlistenouvelle

lignefinlisteexistante = lignedebut
Do While ActiveWorkbook.Worksheets("listes").Cells(lignefinlisteexistante, colonnelisteexistante).Value <> ""
lignefinlisteexistante = lignefinlisteexistante + 1
Loop
ligneparcourslisteexistante = lignefinlisteexistante

lignefinlisteajouter = lignedebut
Do While ActiveWorkbook.Worksheets("listes").Cells(lignefinlisteajouter, colonnelisteaajouter).Value <> ""
ActiveWorkbook.Worksheets("listes").Cells(lignefinlisteajouter, colonnelisteaajouter).Value = ""
lignefinlisteajouter = lignefinlisteajouter + 1
Loop

'fin init

'debut parcours
Do While ligneparcourslistenouvelle >= lignedebut

lignefinlisteexistante = lignedebut
Do While ActiveWorkbook.Worksheets("listes").Cells(lignefinlisteexistante, colonnelisteexistante).Value <> ""
lignefinlisteexistante = lignefinlisteexistante + 1
Loop
ligneparcourslisteexistante = lignefinlisteexistante

existedeja = 0
Do While ligneparcourslisteexistante >= lignedebut
If _
ActiveWorkbook.Worksheets("listes").Cells(ligneparcourslistenouvelle, colonnelistenouvelle).Value _
= ActiveWorkbook.Worksheets("listes").Cells(ligneparcourslisteexistante, colonnelisteexistante).Value _
Then
existedeja = 1
Exit Do
End If
ligneparcourslisteexistante = ligneparcourslisteexistante - 1
Loop

If existedeja = 0 Then

ActiveWorkbook.Worksheets("listes").Cells(ligneajout, colonnelisteaajouter).Value = _
ActiveWorkbook.Worksheets("listes").Cells(ligneparcourslistenouvelle, colonnelistenouvelle).Value
ligneajout = ligneajout + 1

End If

ligneparcourslistenouvelle = ligneparcourslistenouvelle - 1
Loop
'fin parcours

MsgBox "Liste des entrées à ajouter crée"

----------------------------------------

A+
Madelio

eriiic · Answer

Rhooo, on ne peut même plus s'absenter un peu... ;-)  
Voici quand même ma version :  
Je préfère utiliser une 3ème feuille, et mettre 1 pour feuil1, 2 pour feuil2 et 3 pour feuil1+feuil2, ça heurte moins ma logique ;-)  

Sub controle()  
    Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet  
    Dim derlig1 As Long, derlig2 As Long, derlig3 As Long  
    Dim c As Range, r1, r2  
    Set sh1 = Worksheets("Feuil1")  
    Set sh2 = Worksheets("Feuil2")  
    Set sh3 = Worksheets("Feuil3")  
    derlig1 = sh1.[A65536].End(xlUp).Row  
    derlig2 = sh2.[A65536].End(xlUp).Row  
    Application.ScreenUpdating = False  
    ' vider sh3  
    sh3.Range("A:B").Delete  
    sh3.[A1] = "Nom"  
    ' copier datas feuil1  
    sh1.Range("A2:A" & sh1.[A65536].End(xlUp).Row).Copy Destination:=sh3.[A2]  
    ' copier datas feuil2  
    sh2.Range("A2:A" & sh2.[A65536].End(xlUp).Row).Copy sh3.[A65536].End(xlUp).Offset(1, 0)  
    ' éliminer doublons  
    sh3.Range("A1:A" & sh3.[A65536].End(xlUp).Row).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=sh3.Range("B1"), Unique:=True  
    sh3.Range("A:A").Delete  
    sh3.[B1] = "Feuille"  
    derlig3 = sh3.[A65536].End(xlUp).Row  
    ' calcul présence  
    For Each c In sh3.Range("A2:A" & derlig3)  
        c.Offset(0, 1) = IIf(Application.WorksheetFunction.CountIf(sh1.Range("A2:A" & derlig1), c.Value) > 0, 1, 0) + IIf(Application.WorksheetFunction.CountIf(sh2.Range("A2:A" & derlig2), c.Value) > 0, 2, 0)  
    Next c  
    Application.ScreenUpdating = True  
End Sub  

Michel si tu pouvais comparer, je n'ai pas de grande liste...  
Je pense mettre moins de 3h aussi ;-) 
Bonne balade :-)  

Oliv, regarde aussi la proposition de michel à 13h27

eric

oliv'' · Answer

Je viens de tester vos deux macros et les deux me conviennent parfaitement , même si j'ai une petite préférence pour celle d'eric qui donne les numéros! Enfin bon Michel à été plus rapide! ;) 

En tout cas je tiens vraiment à vous remercier pour le temps que vous aurez pris pour m'aider (le duel en face du PC à été tres long ce matin!)

Bonne continuation à vous et peut être à bientôt!

olivier

eriiic · Answer

Si tu dois l'utiliser souvent ça vaut peut-être le coup d'adapter celle de michel, il travaille en mémoire et il doit y avoir un gain significatif. 
A voir...

Edit: et si tu travailles sur 2007 il y aura des petites modif à faire pour augmenter le nombre de lignes utilisables

oliv'' · Answer

euh désolé d'avoir valider le topic! En fait je me suis aperçu d'un petite modif qui serait utile dans ta macro éric!
en fait quand je selectionne les données de mes colonnes, il ne va pas m'implémenter la valeur qui est écrite dans la cellule mais la formule! 
mes données du champs A sont enn fait une concaténation de plusieurs autres colonnes!

Alors oui ta macro marche parfaitement, je l'ai utilisée au préalable sur la liste qu'avait envoyé michel mais je ne m'attendais pas à cela sur mon fichier!

je vais tenter de rectifier cela et si jamais tu as une idée je suis toujours preenur! 

merci.

Indice VBA excel

5 réponses

Votre réponse

Newsletters