Combiner deux tableaux

[apt]

Bonjour à tous,

Comment peut-on combiner deux tableaux dans un troisième dans l'exemple en PJ ?

Merci.

http://cjoint.com/?BEAmtq52KgQ

 

[JCGL]

Re : Combiner deux tableaux

Bonjour à tous,

Tu aurais dû déposer ton fichier sur XLD...
Ton tableau de la feuille 3 contient des valeurs qui ne sont ni sur la feuille 1 ni sur la feuille 2.

Un TCD pourrait faire l'affaire.

A + à tous

 

[apt]

Re : Combiner deux tableaux

Bonsoir JCGL,

Tu aurais dû déposer ton fichier sur XLD...

C'est ma connexion qui me fait défaut.

Dans mon cas, déposer un fichier sur cjoint est plus rapide que sur XLD

Ton tableau de la feuille 3 contient des valeurs qui ne sont ni sur la feuille 1 ni sur la feuille 2.

Un exemple ?

Normalement, c'est les mêmes valeurs extraites de feuil1 et feuil2.

Un TCD pourrait faire l'affaire.

Non, parce que j'ai besoin d'un tableau come indiqué, pour recopier les lignes dans un autre classeur.

 

[JCGL]

Re : Combiner deux tableaux

Bonjour à tous,

En rouge les valeurs dont je ne comprends pas la provenance.

A + à tous

 

[apt]

Re : Combiner deux tableaux

Re,

Oui, tu as raison.

J'ai simplement oublié de mettre les mêmes appellations.

Voila une nouvelle tentative en VBA avec des en-têtes corrigés.

Sub CmbnTab()
    Dim WS1 As Worksheet, WS2 As Worksheet, WS3 As Worksheet
    Dim Plg As Range, PlgWS1 As Range, PlgWS2 As Range

    Set mondico = CreateObject("Scripting.Dictionary")

    Set WS1 = Sheets("feuil1")
    Set WS2 = Sheets("feuil2")
    Set WS3 = Sheets("feuil3")

    With WS1
        Set PlgWS1 = .Range(.[A2], .[A65000].End(xlUp))
    End With
    With WS2
        Set PlgWS2 = .Range(.[A2], .[A65000].End(xlUp))
    End With

    Set Plg = Union(PlgWS1, PlgWS2)
    For Each c In Plg
        If Not mondico.Exists(c.Value) Then mondico1.Add c.Value, c.Value
    Next c
    Sheets("feuil3").[A2].Resize(mondico.Count, 1) = Application.Transpose(mondico.keys)

    For Each c In WS3.Range(WS3.[A2], WS3.[A65000].End(xlUp))
        
        '-- Extration des valeurs depuis feuil1
        x = Application.Match(c, WS1.Columns(1), 0)
        If x > 0 Then
            c.Offset(, 2) = x.Offset(, 1)    'NCS
            c.Offset(, 4) = x.Offset(, 2)    'QS
            c.Offset(, 5) = x.Offset(, 3)    'QT
        End If

        '-- Extration des valeurs depuis feuil2
        x = Application.Match(c, WS2.Columns(1), 0)
        If x > 0 Then
            c.Offset(, 1) = x.Offset(, 1)    'NVD
            c.Offset(, 3) = x.Offset(, 2)    'TRF
        End If
    Next c
End Sub

 

[apt]

Re : Combiner deux tableaux

Salut,

Une autre tentative, mais j'ai un souci pour la plage "Plg" : elle toujours vide !

Sub CmbnTab()
    Dim WS1 As Worksheet, WS2 As Worksheet, WS3 As Worksheet
    Dim Plg As Range, PlgWS1 As Range, PlgWS2 As Range

    Set mondico = CreateObject("Scripting.Dictionary")

    Set WS1 = Sheets("feuil1")
    Set WS2 = Sheets("feuil2")
    Set WS3 = Sheets("feuil3")

    With WS1
        Set PlgWS1 = .Range(.[A2], .[A65000].End(xlUp))
    End With
    With WS2
        Set PlgWS2 = .Range(.[A2], .[A65000].End(xlUp))
    End With

    Set Plg = Union(Range(PlgWS1.Address), Range(PlgWS2.Address))
    
    For Each c In Plg
        If Not mondico.Exists(c.Value) Then mondico.Add c.Value, c.Value
    Next c

    With WS3
        .[A2:F100].ClearContents
        .[A2].Resize(mondico.Count, 1) = Application.Transpose(mondico.keys)
    End With

    For Each c In WS3.Range(WS3.[A2], WS3.[A65000].End(xlUp))

        '-- Extration des valeurs depuis feuil1
        With WS1
            x = Application.Match(c, .Columns(1), 0)
            If Not IsError(x) Then
                If x > 0 Then
                    c.Offset(, 2) = .Range("A" & x).Offset(, 1)    'NCS
                    c.Offset(, 4) = .Range("A" & x).Offset(, 2)    'QS
                    c.Offset(, 5) = .Range("A" & x).Offset(, 3)    'QT
                End If
            End If
        End With
        '-- Extration des valeurs depuis feuil2
        With WS2
            x = Application.Match(c, .Columns(1), 0)
            If Not IsError(x) Then
                If x > 0 Then
                    c.Offset(, 1) = .Range("A" & x).Offset(, 1)    'NVD
                    c.Offset(, 3) = .Range("A" & x).Offset(, 2)    'TRF
                End If
            End If
        End With
    Next c
End Sub

 

[Paritec]

Re : Combiner deux tableaux

Bonjour Apt le forum
voilà ton fichier en retour
a+
papou😱

 

[Paritec]

Re : Combiner deux tableaux

Re Apt le forum
une autre version avec le formatage des colonnes %
a+
papou😱

 

[apt]

Re : Combiner deux tableaux

Bonsoir papou,

Ca marche très bien.

Je vais continu à essayer sur le fichier originel.

Merci bien.