fusionner deux tableau sans destruction des données

D

delphi_jb

XLDnaute Nouveau
Bonjour à toutes et à tous :cool:

voila j'ai un petit soucis, que je vous expose.
j'ai un fichier excel qui contient deux tableaux similaire,
placé respectivement sur deux feuilles différentes. Voici leur nomenclature:


Tableau 1 (feuil1):
DateNomChiffre
16/10/2011Durant339
16/10/2011lorient852
18/10/2011friot996


Tableau 2 (feuil2):
DateNomChiffre
16/10/2011lorient852
17/10/2011miraut109
20/10/2011francoise544



j'aurais souhaité, sur une troisième feuille excel (qu'on nommera 'Feuil3'), un tableau
récapitulatif qui fusionne les deux premiers en triant sur la date, mais de manière
non destructive, comme ceci:

Tableau 3 (feuil):
Date 1Nom 1Nom 2Chiffre 1Chiffre 2
16/10/2011durant339
16/10/2011lorient852
16/10/2011lorient852
17/10/2011miraut109
18/10/2011friot996
20/10/2011francoise544


enfin, en clair, j'aurais voulu fusionner les deux tableau en un seul, avec un
client par ligne, et le tout trié sur la date.


avez-vous une idée sur la méthode poure réaliser ceci ?

Un grand merci d'avance :D
 
Trier par date Trier par votes
Dormeur74

Dormeur74

XLDnaute Occasionnel
Re : fusionner deux tableau sans destruction des données

Bonjour,
Essaye cette macro.

Code: 
Sub Macro1()
    Dim y As Long
    Dim lenTab1, lenTab2 As Long
    
    lenTab1 = Sheets("Feuil1").Cells(Rows.Count, 1).End(xlUp).Row
    lenTab2 = Sheets("Feuil2").Cells(Rows.Count, 1).End(xlUp).Row
    
    Sheets("Feuil3").Select

    For y = 2 To lenTab1
        Cells(y, 1) = Sheets("Feuil1").Cells(y, 1)
        Cells(y, 2) = Sheets("Feuil1").Cells(y, 2)
        Cells(y, 4) = Sheets("Feuil1").Cells(y, 3)
    Next y
    For y = lenTab1 + 2 To lenTab1 + lenTab2
        Cells(y - 1, 1) = Sheets("Feuil2").Cells(y - lenTab1, 1)
        Cells(y - 1, 3) = Sheets("Feuil2").Cells(y - lenTab1, 2)
        Cells(y - 1, 5) = Sheets("Feuil2").Cells(y - lenTab1, 3)
    Next y
        
    ' On trie par dates
    Cells.Select
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("A2").Select
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
D

delphi_jb

XLDnaute Nouveau
Re : fusionner deux tableau sans destruction des données

Dormeur74 à dit:
Bonjour,
Essaye cette macro.

Code: 
Sub Macro1()
    Dim y As Long
    Dim lenTab1, lenTab2 As Long
    
    lenTab1 = Sheets("Feuil1").Cells(Rows.Count, 1).End(xlUp).Row
    lenTab2 = Sheets("Feuil2").Cells(Rows.Count, 1).End(xlUp).Row
    
    Sheets("Feuil3").Select

    For y = 2 To lenTab1
        Cells(y, 1) = Sheets("Feuil1").Cells(y, 1)
        Cells(y, 2) = Sheets("Feuil1").Cells(y, 2)
        Cells(y, 4) = Sheets("Feuil1").Cells(y, 3)
    Next y
    For y = lenTab1 + 2 To lenTab1 + lenTab2
        Cells(y - 1, 1) = Sheets("Feuil2").Cells(y - lenTab1, 1)
        Cells(y - 1, 3) = Sheets("Feuil2").Cells(y - lenTab1, 2)
        Cells(y - 1, 5) = Sheets("Feuil2").Cells(y - lenTab1, 3)
    Next y
        
    ' On trie par dates
    Cells.Select
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("A2").Select
End Sub
Cliquez pour agrandir...

Bonjour,

Merci, cela a l'air de bien fonctionner effectivement !
seulement, honte a moi, j'ai oublié de mentionner qu'il y avait en réalité 5 colonnes (et non 3) par tableau.
j'avais fait cela car je voulais simplifier la chose pour se concentrer sur le concept, mais j'avais pas pensé
qu'on en arriverai au VBA ^^

Je vais essayer d'adapter votre code pour partir de 5 colonnes au lieu de 3, même si vous risquez d'être
plus rapide que moi ^^
 
Dernière édition:
Vote positif 0 Vote négatif
D

delphi_jb

XLDnaute Nouveau
Re : fusionner deux tableau sans destruction des données

C'est bon, j'ai trouvé (j'ai compris la logique de votre code ^^)

Code: 
Sub Macro1()
    Dim y As Long
    Dim lenTab1, lenTab2 As Long
    
    lenTab1 = Sheets("Feuil1").Cells(Rows.Count, 1).End(xlUp).Row
    lenTab2 = Sheets("Feuil2").Cells(Rows.Count, 1).End(xlUp).Row
    
    Sheets("Feuil3").Select

    For y = 2 To lenTab1
        Cells(y, 1) = Sheets("Feuil1").Cells(y, 1)
        Cells(y, 2) = Sheets("Feuil1").Cells(y, 2)
        Cells(y, 4) = Sheets("Feuil1").Cells(y, 3)
        Cells(y, 6) = Sheets("Feuil1").Cells(y, 4)
        Cells(y, 8) = Sheets("Feuil1").Cells(y, 5)
    Next y
    For y = lenTab1 + 2 To lenTab1 + lenTab2
        Cells(y - 1, 1) = Sheets("Feuil2").Cells(y - lenTab1, 1)
        Cells(y - 1, 3) = Sheets("Feuil2").Cells(y - lenTab1, 2)
        Cells(y - 1, 5) = Sheets("Feuil2").Cells(y - lenTab1, 3)
        Cells(y - 1, 7) = Sheets("Feuil2").Cells(y - lenTab1, 4)
        Cells(y - 1, 9) = Sheets("Feuil2").Cells(y - lenTab1, 5)
    Next y
        
    ' On trie par dates
    Cells.Select
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("A2").Select
End Sub

Un grand merci pour ce dernier !



tant que je vous tient, est-il possible de coloriser différemment champs/lignes et ce, en
fonction des dates colorisation du fond sur 9 colonnes donc)

en fond bleu:
6/11/2012
6/11/2012
6/11/2012

en fond rouge:
7/11/2012
7/11/2012
7/11/2012

en fond bleu:
9/11/2012
9/11/2012

en fond rouge:
12/11/2012
12/11/2012
12/11/2012
12/11/2012
12/11/2012

etc



en tout cas, un grand merci pour ce qui à déja été fait ! :cool:
 
Vote positif 0 Vote négatif
Dormeur74

Dormeur74

XLDnaute Occasionnel
Re : fusionner deux tableau sans destruction des données

La mienne est prête, mais je préfère te laisser bosser dessus.:eek:

Oooooo ! Tu vas trop vite. Bon, après les couleurs, il y a autre chose ? "On ne nous dit pas tout !"

Je modifie à nouveau mon message, car là il nous faudrait une logique. Est-ce qu'on change de couleur chaque fois qu'on change de jour ?
 
Dernière édition:
Vote positif 0 Vote négatif
D

delphi_jb

XLDnaute Nouveau
Re : fusionner deux tableau sans destruction des données

(normalement, plus de feature apres la couleur ^^)

Oui, chaque nouveau jour se voit attribuer une nouvelle couleur de fond
(forcement la même pour tout les même jour ^^)

j'en suis la:

Code: 
Sub Macro1()
    Dim y As Long
    Dim t As Long
    Dim lenTab1 As Long
    Dim couleur()
    
    couleur(0) = 40
    couleur(1) = 42
    
    lenTab1 = Sheets("Feuil3").Cells(Rows.Count, 1).End(xlUp).Row
    
    Sheets("Feuil3").Select

    For y = 2 To lenTab1
        If (Cells(y, 1) <> Cells(y - 1, 1)) Then
        
            For t = 1 To 9
                Cells(y, t) = Sheets("Feuil3").Cells(y, 1).Interieur.ColorIndex = couleur(0)
            Next t
            
        End If
    Next y
End Sub

il ne me reste plus qu'a trouver un truc pour qu'il switch sur la valeurs de mon tableau
et ainsi, je pense avoir résolu le truc ^^
 
Vote positif 0 Vote négatif
Dormeur74

Dormeur74

XLDnaute Occasionnel
Re : fusionner deux tableau sans destruction des données

Alors essaye ceci :

Code: 
Sub Macro1()
    Dim x, y As Long
    Dim lenTab1, lenTab2 As Long
    Dim couleur1, couleur2 As Integer
   
    lenTab1 = Sheets("Feuil1").Cells(Rows.Count, 1).End(xlUp).Row
    lenTab2 = Sheets("Feuil2").Cells(Rows.Count, 1).End(xlUp).Row
    couleur1 = 3
    couleur2 = 5
    
    Sheets("Feuil3").Select

    For y = 2 To lenTab1
        Cells(y, 1) = Sheets("Feuil1").Cells(y, 1)
        Cells(y, 2) = Sheets("Feuil1").Cells(y, 2)
        Cells(y, 4) = Sheets("Feuil1").Cells(y, 3)
        Cells(y, 6) = Sheets("Feuil1").Cells(y, 4)
        Cells(y, 8) = Sheets("Feuil1").Cells(y, 5)
    Next y
    For y = lenTab1 + 2 To lenTab1 + lenTab2
        Cells(y - 1, 1) = Sheets("Feuil2").Cells(y - lenTab1, 1)
        Cells(y - 1, 3) = Sheets("Feuil2").Cells(y - lenTab1, 2)
        Cells(y - 1, 5) = Sheets("Feuil2").Cells(y - lenTab1, 3)
        Cells(y - 1, 7) = Sheets("Feuil2").Cells(y - lenTab1, 4)
        Cells(y - 1, 9) = Sheets("Feuil2").Cells(y - lenTab1, 5)
    Next y

    ' On trie par dates
    Cells.Select
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
        
    ' On met la première ligne en rouge pour initialiser
    Range("A2:I2").Interior.ColorIndex = couleur1
    For y = 2 To lenTab1 + lenTab2 - 1
        If Cells(y, 1) <> Cells(y - 1, 1) Then
            If Cells(y - 1, 1).Interior.ColorIndex = couleur1 Then
                Range("A" & y & ":" & "I" & y).Interior.ColorIndex = couleur2
            Else
                Range("A" & y & ":" & "I" & y).Interior.ColorIndex = couleur1
            End If
        Else
            Range("A" & y & ":" & "I" & y).Interior.ColorIndex = Cells(y - 1, 1).Interior.ColorIndex
        End If
    Next y
End Sub
 
Vote positif 0 Vote négatif
MJ13

MJ13

XLDnaute Barbatruc
Re : fusionner deux tableau sans destruction des données

Bonjour DelphiJb, Dormeur

Attention quand vous écrivez ce code:

Code: 
Dim x, y As Long
    Dim lenTab1, lenTab2 As Long
    Dim couleur1, couleur2 As Integer

Il me semble que le premier est en variant et le second est dans le type que vous avez défini :eek:. Bon, Après, si cela ne pose pas de problèmes dans votre macro, ce n'est pas bien grave :).
 
Vote positif 0 Vote négatif
Dormeur74

Dormeur74

XLDnaute Occasionnel
Re : fusionner deux tableau sans destruction des données

C'est même un transtypage très dangereux.

Code: 
Sub Macro1()
    Dim ligne1, ligne2 As Integer 
    
    ligne1 = 14500000
    ligne2 = 32000
End Sub

Tout va bien, ligne1 Variant est transtypé en Long

Code: 
Sub Macro1()
    Dim ligne1 As Integer, ligne2 As Integer 
    
    ligne1 = 14500000
    ligne2 = 32000
End Sub

ligne1 provoque un dépassement de capacité.
 
Vote positif 0 Vote négatif

Discussions similaires

F
  • Question
Microsoft 365 Concaténation et mise en forme de données
Réponses
3
Affichages
418
Fab117
F
B
  • Question
XL 2016 Fusionner 2 tableaux sans connaître le nombre de ligne des 2 tableaux
Réponses
12
Affichages
768
mapomme
mapomme
I
  • Résolu(e)
XL 2019 Supprimer une ligne d'une base de données une fois qu'elle est transférée sur une autre feuille
Réponses
8
Affichages
403
Isabellisa
I
A
  • Résolu(e)
Microsoft 365 Trop de caractères de continuité de ligne
Réponses
9
Affichages
501
TooFatBoy
TooFatBoy
R
  • Question
Microsoft 365 Supprimer les lignes vides d'une variable tableau
Réponses
1
Affichages
432
Phil69970
Phil69970
J
  • Question
Microsoft 365 VBA
2
Réponses
18
Affichages
2 K
jilooou
J
M
  • Question
Microsoft 365 Programme trop lent
Réponses
12
Affichages
693
Hasco
Hasco
S
  • Question
XL 2019 Transfer de données du formulaire vers un tableau après click sur le CommandButton1.
Réponses
4
Affichages
853
sgangbadjo
S
C
  • Question
XL 2016 calcul sur horaire
2
Réponses
17
Affichages
3 K
jaypeeh
J
S
  • Question
XL 2019 modifications macro svp
Réponses
3
Affichages
768
Bernard_XLD
Bernard_XLD

Membres actuellement en ligne

20 membres et 404 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 251
Messages
2 086 623
Membres
103 266
dernier inscrit
moonie