recherche valeur identique

[obyone]

bonjour,

je recherche une macro qui lorsque je clic sur mon bouton "recherche mise à jour" dans la feuille essai, me compare la colonne 1 à la colonne 2 et me copie dans le tableau de la feuille MAJ uniquement les données différentes soit pour mon exemple dans la colonne nouveau nom 2.pdf.
ma macro ne fonctionne que s'ils sont sur la même ligne.
merci d'avance

oby

 

[Robert]

Bonsoir Obyone, bonsoir le forum,

Peut-être comme ça :

Sub Macro1()
Dim E As Worksheet 'déclare la variable E (onglet Essai)
Dim M As Worksheet 'déclare la variable MAJ (onglet MAJ)
Dim PL As Range 'déclare la variable PL (PLage)
Dim R As Range 'déclare la variable R
Dim TD() As Variant 'déclare la variable TD (Tableau des Différences)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)

Set E = Worksheets("essai") 'définit l'onglet E
Set M = Worksheets("MAJ") 'définit l'onglet M
Set PL = E.Range("A1").CurrentRegion 'définit la plage PL

'compare la colonne 1 avec la 2
For I = 2 To E.Range("A1").CurrentRegion.Rows.Count 'boucle sur toutes les lignes I de la plage PL
    If E.Cells(I, 1).Value <> "" Then 'condition 1 : si la cellule ligne I colonne 1 n'est pas vide
        'définit la recherche R (recherche dans la colonne 2 de la plage PL la valeur entière de la cellule ligne I colonne 1)
        Set R = Application.Intersect(PL, E.Columns(2)).Find(E.Cells(I, 1), , xlValues, xlWhole)
        If R Is Nothing Then 'condition 2 : si aucune occurrence n'est trouvée
            ReDim Preserve TD(J) 'redimensionne le tableau des différences TD
            TD(J) = E.Cells(I, 1) 'récupère dans la tableau TD la valeur de la cellule ligne I, colonne 1
            J = J + 1 'incrémente J
        End If 'fin de la condition 2
    End If 'fin de la condition 1
Next I 'prochaine ligne de la boucle

'compare la colonne 2 avec la 1
For I = 2 To E.Range("A1").CurrentRegion.Rows.Count 'boucle sur toutes les lignes I de la plage PL
    If E.Cells(I, 2).Value <> "" Then 'condition 1 : si la cellule ligne I colonne 2 n'est pas vide
        'définit la recherche R (recherche dans la colonne 1 de la plage PL la valeur entière de la cellule ligne I colonne 2)
        Set R = Application.Intersect(PL, E.Columns(1)).Find(E.Cells(I, 2), , xlValues, xlWhole)
        If R Is Nothing Then 'condition 2 : si aucune occurrence n'est trouvée
            ReDim Preserve TD(J) 'redimensionne le tableau des différences TD
            TD(J) = E.Cells(I, 2) 'récupère dans la tableau TD la valeur de la cellule ligne I, colonne 2
            J = J + 1 'incrémente J
        End If 'fin de la condition 2
    End If 'fin de la condition 1
Next I 'prochaine ligne de la boucle

'renvoie dans A2 redimensionnées le tableau TD transposé
M.Range("A2").Resize(UBound(TD) + 1, 1).Value = Application.Transpose(TD)
End Sub

 

[chris]

Bonjour
Salut Robert

Autre approche

Sub Bouton2_Clic()
Dim x As Long
Dim Extrait As Range

    Range("J1:K1").Value = Range("A1:B1").Value
    Range("H2").Formula = "=A1<>B1"
    x = Worksheets("MAJ").ListObjects("MAJ").ListRows.Count
   
    Range("A:B").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
        "H1:H2"), CopyToRange:=Columns("J:K"), Unique:=False
    Set Extrait = Range("J1").CurrentRegion.Offset(1, 0)
    Extrait.Resize(Extrait.Rows.Count - 1, 2).Copy Destination:=Worksheets("MAJ").Range("MAJ[Nouveau Nom]").Offset(x, 0)
    Application.CutCopyMode = False
    Range("J:K").ClearContents
    Range("H2").ClearContents

End Sub

 

[obyone]

bonjour,

merci à vous 2,

la proposition de robert fonction à merveille

@+ sur le forum

oby

 

[obyone]

rebonjour,

j'ai un problème

" Erreur d'execution'5':
argument ou appel de procédure incorrect"

sur la ligne

M.Range("C2").Resize(UBound(TD) + 1, 1).Value = Application.Transpose(TD)

lors de la seconde exécution?
je ne comprends pas pourquoi

merci d'avance

 

[Dranreb]

Bonjour.
Mettez avant l'instruction qui plante: If j < 1 Then Exit Sub

 

[obyone]

bonjour,
merci cela fonctionne
bon samedi