fusionner deux tableau sans destruction des données

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
 

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:

delphi_jb

XLDnaute Nouveau
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

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:

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:
 

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:

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 ^^
 

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
 

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 :).
 

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é.
 

Discussions similaires

  • Question
Microsoft 365 VBA
Réponses
18
Affichages
2 K
Réponses
12
Affichages
730
Réponses
17
Affichages
3 K

Statistiques des forums

Discussions
312 884
Messages
2 093 248
Membres
105 658
dernier inscrit
Mario Richard