fusion de tableau avec comparaison d'une cellule

[Emmaude]

Bonjour,

j'en appelle aux dieux d'Excel, pour un gros travail, bien au delà de mes compétences 😛

Voilà mon objectif :
dans chacun des tableaux Lancelot et Solis, je dois comparer l'identifiant, et lorsque celui correspond, j'aimerai coller la ligne d'un des tableaux sur l'autre, à la suite de celle contenant le bon identifiant (ou créer une autre feuille, un autre classeur, ça m'est égal), pour obtenir quelque chose qui correspond au tableau "exemple".

Si'il n'est pas possible de coller les lignes sans correspondance, juste me les mettre en surbrillance suffit aussi

D'avance merci aux âmes charitables qui auront pitié de moi !!!

 

[klin89]

Bonsoir le fil, 🙂

Comme le souligne Modeste au post #7, tu veux opérer un simple alignement.
J'ai placé tes données dans un même classeur et nommer les feuilles en conséquence.

Les clés du dictionnaire sont les différents identifiants de la colonne 2
L'item associé à chaque clé est un tableau à 1 dimension de 18 éléments (soit une ligne de 18 cellules lors de la restitution).

Option Explicit

Sub alignement()
Dim a, i As Long, j As Long, w(), txt As String, x, y
    a = Sheets("LANCELOT").Range("a1").CurrentRegion.Value
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For i = 1 To UBound(a, 1)
            txt = CStr(a(i, 2))
            ReDim w(1 To 18)
            For j = 1 To UBound(a, 2)
                w(j + 12) = a(i, j)
            Next
            .Item(txt) = w
        Next
        a = Sheets("SOLIS").Range("a1").CurrentRegion.Value
        For i = 1 To UBound(a, 1)
            txt = CStr(a(i, 2))
            If .exists(txt) Then
                w = .Item(txt)
                For j = 1 To UBound(a, 2)
                    w(j) = a(i, j)
                Next
            Else
                ReDim w(1 To 18)
                For j = 1 To UBound(a, 2)
                    w(j) = a(i, j)
                Next
            End If
            .Item(txt) = w
        Next
        y = .items: x = .Count
    End With
    Application.ScreenUpdating = False
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("Resultat").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    Sheets.Add.Name = "Resultat"
    With Sheets("Resultat").Cells(1)
        .Resize(x, 18).FormulaLocal = _
        Application.Transpose(Application.Transpose(y))
        With .CurrentRegion
            .Font.Name = "calibri"
            .BorderAround Weight:=xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            .VerticalAlignment = xlCenter
            With .Rows(1)
                .HorizontalAlignment = xlCenter
                .Interior.ColorIndex = 40
                .Font.Bold = True
                .BorderAround Weight:=xlThin
            End With
            .Columns("e").NumberFormat = "mmm-yy"
            .Columns("p:r").NumberFormat = "# ##0.00"
            .Columns.AutoFit
        End With
    End With
    Application.ScreenUpdating = True
End Sub

klin89