XL 2016 Comparatif et fusion de deux tableaux deux dimensions

Surferdargent · 27 Mars 2021

Bonjour je ne me doute que c'est un sujet qui a été abordé mais en cherchant je n'ai pas trouvé ma réponse ...
J'ai deux tableaux dynamiques sur deux feuilles ( 1 et 2 ) différentes avec une colonne en commune et je voudrais que toutes les lignes de la feuille 2 se collent à la suite du tableau de la feuille 1 sauf la colonne en commun . Une sorte de fusion . La difficulté c'est que les deux tableaux d'origine peuvent avoir des colonnes et des lignes variables. J'essaye de me perfectionner sur les variables tableau mais j'ai encore du mal ci joint un fichier en pièce jointe mon code qui ne fonctionne pas .
Un petit coup de main et quelques explications ce serait sympa.

VB:

Sub fusion_tableau()
Dim montableau As Variant, i As Long, j As Long
Dim montableau2 As Variant
Dim resultat() As Variant

Set T1 = Sheets("1")
Set T2 = Sheets("2")

montableau = T1.Range("A1").CurrentRegion
montableau2 = T2.Range("A1").CurrentRegion

For i = LBound(montableau, 1) To UBound(montableau, 1)
        For j = LBound(montableau2, 1) To UBound(montableau2, 1)
            If montableau(i, 1) = montableau2(j, 1) Then
            redim resultat = montableau(i,(ubound(montableau,2))+ montableau2(j,(ubound(montableau,2))  ' <-c'est le résultat que j'attends mais la je bug
            End If
        Next j
Next i
    
     montableau = resultat ' effacement du premier tableau en feuille 1 pour mettre le nouveau à la place en A1 , la je bug aussi
End Sub

Surferdargent · 27 Mars 2021

Bonjour
Franchement top ton programme job75 et en plus il conserve la mise en forme ,je vais essayer de décortiquer ton code pour l'adapter sur d'autres fichiers merci beaucoup .

R@chid · 27 Mars 2021

Bonjour et Bienvenue sur XLD,
avec Power Query et la fusion des deux requêtes on pourrait obtenir facilement le résultat souhiaté.
Après l'ajout des données dans le tableau 2, fais un clic-droit dans le tableau vert puis Actualiser.

Voir PJ

Cordialement

Surferdargent · 27 Mars 2021

Bonjour R@achid je te remercie d'avoir pris le temps de me répondre cette manipulation je la connaissais mais je souhaitais passer par des variables tableaux car PowerQuery je n'ai pas accès au travail.
Mais encore merci si tu as d' autres idées je suis preneur .

job75 · 27 Mars 2021

Bonjour Surferdargent, R@chid,

Voyez le fichier joint et cette macro :

VB:

Sub Fusionner()
Dim d As Object, P1 As Range, P2 As Range, ncol1%, ncol2%, resu(), tablo, i&, x$, n&, j%, lig&
Set d = CreateObject("Scripting.Dictionary")
Set P1 = Sheets("1").[A1].CurrentRegion 'à adapter
Set P2 = Sheets("2").[A1].CurrentRegion 'à adapter
ncol1 = P1.Columns.Count
ncol2 = P2.Columns.Count - 1
ReDim resu(1 To P1.Rows.Count + P2.Rows.Count, 1 To ncol1 + ncol2)
tablo = P1.Resize(P1.Rows.Count + 1) 'matrice, plus rapide, au moins 2 éléments
For i = 1 To UBound(tablo) - 1
    x = CStr(tablo(i, 1))
    If Not d.exists(x) Then 'les doublons en colonne A sont ignorés, il ne doit donc pas y en avoir
        n = n + 1
        d(x) = n 'mémorise la ligne
        For j = 1 To ncol1
            If IsDate(tablo(i, j)) Then resu(n, j) = CDate(tablo(i, j)) Else resu(n, j) = tablo(i, j)
        Next j
    End If
Next i
tablo = P2.Resize(P2.Rows.Count + 1) 'matrice, plus rapide, au moins 2 éléments
For i = 1 To UBound(tablo) - 1
    x = CStr(tablo(i, 1))
    If Not d.exists(x) Then 'il ne doit pas y avoir de doublon en colonne A
        n = n + 1
        d(x) = n 'mémorise la ligne
        resu(n, 1) = x
    End If
    lig = d(x)
    For j = 1 To ncol2
        If IsDate(tablo(i, j + 1)) Then resu(lig, j + ncol1) = CDate(tablo(i, j + 1)) Else resu(lig, j + ncol1) = tablo(i, j + 1)
Next j, i
'---restitution et mise en forme---
Application.ScreenUpdating = False
With Sheets("Fusion") 'à adapter
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    .Cells.ClearContents 'RAZ
    .Cells.Borders.LineStyle = xlNone 'RAZ
    .Columns.ColumnWidth = .Columns(.Columns.Count).ColumnWidth 'RAZ
    .[A1].Resize(n, ncol1 + ncol2) = resu
    .[A1].CurrentRegion.Borders.Weight = xlThin 'bordures
    .Columns.AutoFit 'ajustement largeurs
    With .UsedRange: End With 'actualise les barres de défilement
    .Activate 'facultatif
End With
End Sub

Elle est très rapide car elle utilise des tableaux VBA et le Dictionary.

Pour la bonne marche il ne faut pas de doublon en colonne A des feuilles, j'ai vérifié c'est bien le cas.

A+

Surferdargent · 27 Mars 2021

Bonjour
Franchement top ton programme job75 et en plus il conserve la mise en forme ,je vais essayer de décortiquer ton code pour l'adapter sur d'autres fichiers merci beaucoup .

job75 · 27 Mars 2021

Surferdargent à dit:
en plus il conserve la mise en forme

Non, seules les dates sont traitées pour être restituées correctement.

Pour les nombres j'ai formaté manuellement les colonnes A D et G de la feuille "Fusion".

Surferdargent · 27 Mars 2021

Super il me convient très bien !!!

XL 2016 Comparatif et fusion de deux tableaux deux dimensions

Surferdargent

XLDnaute Nouveau

Pièces jointes

Surferdargent

R@chid

XLDnaute Barbatruc

Pièces jointes

Surferdargent

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Pièces jointes

Surferdargent

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Surferdargent

XLDnaute Nouveau

Discussions similaires