Concaténer deux tableaux en supprimant les doublons

Bonjour tout le monde,

voila moi problème, j'ai deux tableaux sur des feuilles differentes que je souhaiterais rassembler en un seul. sachant qu'il ne peut y avoir des doublons que dans les lignes et que les colonnes doivent être à la suite dans le tableau de résultat.

Un petit exemple pour vous montrer. Je souhaiterai avoir une macro qui me rassemble le tableau feuille 1 avec le tableau feuille 2, et il faudrait obtenir le tableau feuille 3.

Merci d'avance à tout le monde

Bonjour à tous,

Pas trop fignolé, départ de la "Feuil1"

Sub FusionneFeuilles()
''Macros par Claude Dubois pour "E-Zekiel" Excel-Pratique le 4 Déc 09
Dim Lg As Long, Lg2 As Long, Cel
Dim X, Y
X = Sheets(1).Name
Y = Sheets(2).Name
        Sheets(1).Activate
        Application.ScreenUpdating = False

        For Each Cel In Range([b4], [b65536].End(xlUp))
                        Lg = Cel.Row
                    Range("t1") = Cel
                    Range("s1") = "=MATCH(t1," & Y & "!b:b,0)"
                If IsError(Range("s1")) = False Then
                        Lg2 = Range("s1")
                    Range(Y & "!c" & Lg2 & ":h" & Lg2).Copy Destination:=Range("i" & Lg)
                End If
            Application.CutCopyMode = False
        Next Cel

    With Sheets(2)
                .Range("c3:h3").Copy Destination:=Range(X & "!i3") 'en-têtes

        For Each Cel In Range(.[b4], .[b65536].End(xlUp))
                Lg = Cel.Row
                Range("t1") = Cel
                Range("s1") = "=MATCH(t1," & X & "!b:b,0)"
            If IsError(Range("s1")) Then
                .Range("b" & Lg).Copy Destination:=Range(X & "!b65000").End(xlUp)(2)
                .Range("c" & Lg & ":h" & Lg).Copy Destination:=Range(X & "!b65000").End(xlUp).Offset(0, 7)
            End If
                Application.CutCopyMode = False
        Next Cel
    End With
        Range("s1:t1").ClearContents
End Sub

Amicalement

Claude

Bonjour Dubois,

Je te remercie beaucoup, ça fonctionne parfaitement, mais je ne comprend pas la moitié du code.

Pourrais tu me l'expliciter un peu que je puisse l'adapter à mes besoins et me débrouiller comme un grand la prochaine fois ? j'aurais besoin de comprendre exactement à quel endroit de ton code tu sélectionnes les données d'entrées et que tu testes les doublons?

Désolé de te demander plus !

re,

Oui, je balaye la colonne B, en S1 j'écris la formule (EQUIV)

Range("s1") = "=MATCH(t1," & Y & "!b:b,0)"

édit: cette ligne de formule ne devrait pas être à l'intérieur de la boucle (inutile de la répéter)

en T1, = la cellule balayée

Si trouve équivalent en feuil2, alors rapatrie les données en feuil1 (au bon endroit)

Ensuite je fais pareil pour la feuil2, à la différence que si ne trouve pas d'équivalence en feuil1,

ajoute les données à la suite de feuil1.

Voilou, en gros

Claude.

J'ai compris en gros, merci beaucoup !

Rebonjour,

Finalement j'ai un petit problème pour mon utilisation de ton programme. Les tableaux que j'utilise moi sont en fait de dimension variable. Or dans ton programme tu as utilisés comme référence dans le tableau des lettres :

.Range("c3:h3")

ou encore

([b4], [b65536].End

Voila mon soucis, dans mon programme je sors des valeurs numériques définissant les dimensions de ces tableaux, le nombre de colonne par exemple. Je sais pas comment faire la correspondance -> c =3 en gros. D'habitude j'utilise ce type de codage

.Cells(k, 2)

pour pouvoir modifier aussi les colonnes en fonction de certaine variable, mais je n'ai pas réussis à modifier ton programme pour cela.

EDIT :

Finalement, je vais créer un nouveau sujet puisque ce n'es plus du tout la même problématique. Je ferme celui la, désolé du up

Bonjour,

C'est une question d'écriture, mais le résultat est le même, exemple:

Sub test() 'les 2 lignes de code sélectionnent "B10"
Dim k%
k = 10 '(N° de ligne)
Range("b" & k).Select
Cells(k, 2).Select
End Sub

ces 2 lignes sont équivalentes, elles sélectionnent la cellule "B10"

Range("b" & k).Select
Cells(k, 2).Select

Claude.

Pour sélectionner une cellule je savais déjà faire mais comment écrire cette sélection d'un rectangle de cellule :

.Range("c4:n5")

et également comment traduire sans les lettres ces instructions :

For Each Cel In Range(.[b6], .[b65536].End(xlUp))

et

Range(Y & "!c" & Lg2 & ":n" & Lg2).Copy Destination:=Range("o" & Lg)

Merci beaucoup Claude de ton aide précieuse,

j'ai créé un autre post sur le sujet, donc faudrait soit le supprimer soit finir cette discussion sur l'autre sujet .

re,

Oui, tu aurais du rester sur ce fil, (solde l'autre)

Que veux-tu ? que je réécrive mon code sous cette forme ?

dans quel but ?

à te relire

Claude.

En fait les tableau que je rassemble sont de tailles variables.

Voila le code que j'utilise pour le moment, je l'ai a peine modifié :

    Dim Lg As Long, Lg2 As Long, Cel
    Dim X, Y
    X = "Temporaire_1"
    Y = "Temporaire_2"
            Sheets("Temporaire_1").Activate
            Application.ScreenUpdating = False

            For Each Cel In Range([b6], [b65536].End(xlUp))
                            Lg = Cel.Row
                        Range("t1") = Cel
                        Range("s1") = "=MATCH(t1," & Y & "!b:b,0)"
                    If IsError(Range("s1")) = False Then
                            Lg2 = Range("s1")
                        Range(Y & "!c" & Lg2 & ":n" & Lg2).Copy Destination:=Range("o" & Lg)
                    End If
                Application.CutCopyMode = False
            Next Cel

        With Sheets("Temporaire_2")
                    .Range("c4:n5").Copy Destination:=Range(X & "!o4") 'en-têtes

            For Each Cel In Range(.[b6], .[b65536].End(xlUp))
                    Lg = Cel.Row
                    Range("t1") = Cel
                    Range("s1") = "=MATCH(t1," & X & "!b:b,0)"
                If IsError(Range("s1")) Then
                    .Range("b" & Lg).Copy Destination:=Range(X & "!b65000").End(xlUp)(2)
                    .Range("c" & Lg & ":n" & Lg).Copy Destination:=Range(X & "!b65000").End(xlUp).Offset(0, 7)
                End If
                    Application.CutCopyMode = False
            Next Cel
        End With
            Range("s1:t1").ClearContents

Le problème et que le nombre de colonne et l'emplacement où les données sont stocké est codé en "dur". :

Range(Y & "!c" & Lg2 & ":n" & Lg2).Copy Destination:=Range("o" & Lg)

De à partir de "o" et de "c" à "n". Hors mes tableau sont de taille variable, il faudrait donc que ces limites changent en fonction d'une autre variable nommé par exemple "nombre_colonne" et qui définirai la valeur n et o. Ca donnerai qqch comme : n=c+nombre_colonne et o=n+1 si c'était du numérique, mais la, on travaille avec des lettres donc je sais vraiment pas comment faire.

re,

Le mieux serait de joindre une copie de ton fichier réel, en ne gardant que

quelques lignes sur chaque feuilles.

Claude.

Voila a partir de quel moment de ma macro que j'utilise ton bout de code, il s'agit donc de réunir les deux feuilles temporaire_1 et temporaire_2 sachant que ces feuilles ne sont pas toujours les mêmes. Donc le nombre de colonnes est variable. J'ai une variable qui me donne le nombre de colonne par temporaire : Nombre_cas(1) et Nombre_cas(2) dans ce cas la.

Si on lance la macro que je t'ai renvoyé modifié, cela ne fonctionne plus puisque les colonnes concernées ne sont plus jusqu'à "n" mais jusqu'à "t" puisqu'il y a 9 colonne cette fois ci.

Merci encore du temps que tu consacres à m'aider.

re,

Bon si je résume, tu auras plusieurs paires d'onglets à concaténer (sur le même fichier et

avec la même macro) ?

Ces onglets auront un nombre de colonnes variable.

C'est bien çà ?

-------------------- Questions -----------------------

1) je suppose que les feuilles "MafiaB_1" et "MafiaB_2" sont tes sources, je ne m'en occupe pas.

2) combien de lignes sur les feuilles ? (environ ou fourchette)

3) il faudrait que les feuilles à traiter soit toujours placées en dernier (ou en 1er), possible ?

et que les tableaux démarrent toujours à la même cellule (ici "B6")

Confirme ces points, cela ne me parait pas "sorcier"

Je conserve le même principe, en ajoutant des variables colonnes.

à te relire

Claude.

oui, c'est en effet les variables pour les colonnes qui manque, étant donné que c'est moi qui créé les temporaire_1 et 2 a partir des deux mafiab, elle ne sont pas en premier, mais j'ai des variables pour leurs nom et leurs références.

Je sais pas si une macro peut facilement déplacer une feuille, si c'est le cas, il suffit de les déplacer avant d'appliquer ton code si c'est plus facile.

Pour la première case B6, je choisis donc oui, les tableaux commencerons toujours la et le nombre de ligne serai grand maximum 100 .

J'espère avoir éclairci suffisamment le problème

Merci beaucoup!

re,

ok, c'est parti !

Je considère que les feuilles à traiter sont placées en dernier

réponse en fin de soirée ou demain en matinée

Claude.

-- Mar Déc 08, 2009 9:34 am --

Bonjour à tous,

Macro modifiée,

Sub FusionneFeuilles()
''Macros par Claude Dubois pour "E-Zekiel" Excel-Pratique le 8 Déc 09
Dim Lg%, Lg2%, CL As Byte, CL2 As Byte
Dim X, Y, Cel As Range
    X = Sheets(Sheets.Count - 1).Name
    Y = Sheets(Sheets.Count).Name
    CL = Sheets(X).Range("bz6").End(xlToLeft).Column
    CL2 = Sheets(Y).Range("bz6").End(xlToLeft).Column

    Sheets(X).Activate
        Application.ScreenUpdating = False

        '**** la cellule "A1" (mémoire dernière colonne d'origine)
        '**** permet de relancer la macro en supprimant les colonnes au delà (pour mise à jour)
        On Error GoTo Fin
                If Range("a1") > 0 Then
                    Range(Columns(Range("a1") + 1), Columns(CL + CL2)).Delete
                    CL = Sheets(X).Range("bz6").End(xlToLeft).Column
                End If
                    Range("a1") = CL
        '****
                Range("s1") = "=MATCH(t1," & Y & "!b:b,0)"
        For Each Cel In Range([b6], [b65536].End(xlUp))
                    Lg = Cel.Row
                    Range("t1") = Cel
            If IsError(Range("s1")) = False Then
                    Lg2 = Range("s1")
                With Sheets(Y)
                    Range(.Cells(Lg2, 3), .Cells(Lg2, CL2)).Copy Destination:=Cells(Lg, CL + 1)
                End With
            End If
        Next Cel

    With Sheets(Y)
            Range("s1") = "=MATCH(t1,b:b,0)"
            Range(.Cells(4, 3), .Cells(5, CL2)).Copy Destination:=Cells(4, CL + 1) 'en-têtes

        For Each Cel In Range(.[b6], .[b65536].End(xlUp))
                Lg2 = Cel.Row
                Range("t1") = Cel
            If IsError(Range("s1")) Then
                .Range("b" & Lg2).Copy Destination:=Range("b65000").End(xlUp)(2) 'nom
                Range(.Cells(Lg2, 3), .Cells(Lg2, CL2)).Copy Destination:=Range("b65000").End(xlUp).Offset(0, CL - 1)
            End If
        Next Cel
    End With
Fin:            Range("s1:t1").ClearContents
End Sub

Bonne journée

Claude.

C'est vraiment parfait

Merci beaucoup pour le mal que tu t'es donné et le temps que tu as passé sur mon problème.

Bonne journée à toi,

Cédric