faire correspondre des données identiques entre 2 colonnes

[gilles72]

Bonjour à vous,
Dans un fichier excel gérant des articles magasin....
2 colonnes dans lesquelles figurent des codes d'articles.
Dans la colonne gauche, l'ancienne liste qui comporte environ 1500articles.
Dans la colonne de droite le mêmes articles complétés d'environ 1000 nouveaux articles intercalés un peu partout.
Je souhaite que les articles communs soient mis face à face et pour cela:
je décale vers le bas les articles de l'ancienne liste pour que les N° correspondent avec ceux de la nouvelle liste
les cellules vides correspondent donc à des articles ajoutés dans la nouvelle liste.

Le code macro que j'ai tenté d'écrire ne fonctionne pas (je suis un vbatiste très moyen!)

Si kekun voit une solution possible, qu'il (elle) reçoive tous mes remerciements!!
Merci d'avance, donc...
Gilles72

 

[Efgé]

Re : faire correspondre des données identiques entre 2 colonnes

Bonjour gilles72, le fil, le forum,
Une proposition:

Sub Decal()
Application.ScreenUpdating = False
With Sheets("Feuil1")
    For I = 4 To .Cells(Rows.Count, 1).End(xlUp).Row
        If .Cells(I, 2) <> "" And _
        .Cells(I, 1).Value <> .Cells(I, 2) Then _
        .Cells(I, 1).Insert Shift:=xlDown
    Next I
End With
Application.ScreenUpdating = True
End Sub

Cordialement

 

[gilles72]

Re : faire correspondre des données identiques entre 2 colonnes

Bonjour Efgé et MERCI
nickel
je te mets pour info mon code qui ne fonctionnait pas:

Sub memecode()
Dim Cal As Range, cell As Range, Ligne As Long
Sheets("feuil1").Select
Set Cal = Range("a4:B20")
For Each cell In Cal
If cell.Offset(0, 0).Value <> cell.Offset(0, 1).Value And cell.Offset(0, 1).Value <> "" Then
'MsgBox (aaaa)
cell.Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End If
Next cell
Application.CutCopyMode = False
End Sub

Merci encore

 

[david84]

Re : faire correspondre des données identiques entre 2 colonnes

Bonjour, salut Efgé,
ci-joint proposition à tester en passant par des tableaux VBA (plus rapide normalement) :

Sub test()
Dim PlageAncListe, PlageNvelleListe, AncListe, NvelleListe, i&, j&, Résultat&, Diff, test
Set PlageAncListe = Sheets("Feuil1").Range("A4", Range("A" & Rows.Count).End(xlUp))
Set PlageNvelleListe = Sheets("Feuil1").Range("B4", Range("B" & Rows.Count).End(xlUp))

AncListe = Sheets("Feuil1").Range("A4", Range("A" & Rows.Count).End(xlUp)).Value
NvelleListe = Sheets("Feuil1").Range("B4", Range("B" & Rows.Count).End(xlUp)).Value
Diff = Application.Evaluate("COUNTA(" & PlageAncListe.Address _
& ")- SUM(COUNTIF(" & PlageAncListe.Address & "," & PlageNvelleListe.Address & "))")

    For i = 1 To PlageNvelleListe.Rows.Count
        Dim tabl()
        ReDim Preserve tabl(1 To PlageNvelleListe.Rows.Count)
        On Error Resume Next
        Résultat = Application.WorksheetFunction.Match(NvelleListe(i, 1), AncListe, 0)
            If Err.Number <> 0 Then
                tabl(i) = ""
                Else
                tabl(i) = AncListe(Résultat, 1)
            End If
    Next i
        
    test = Application.WorksheetFunction.CountA(tabl)
    j = 1
    For i = 1 To PlageAncListe.Rows.Count
        Résultat = Application.WorksheetFunction.CountIf(PlageNvelleListe, AncListe(i, 1))
            If Résultat = 0 Then
                ReDim Preserve tabl(1 To PlageAncListe.Rows.Count + Diff)
                tabl(j + test) = AncListe(i, 1)
                j = j + 1
                End If
            Next i
        [E4].Resize(UBound(tabl)) = Application.Transpose(tabl)
        [F4].Resize(PlageAncListe.Rows.Count) = NvelleListe
End Sub

A+

 

[gilles72]

Re : faire correspondre des données identiques entre 2 colonnes

Merci David
je ne l'ai pas encore testé, car je me suis dépanné avec le code d'Elgé
je te donnele resultat à la suite, dans le fil
merci encore de ton aide
Gilles72