Discussion :

[chloe.secli]

Bonjour
J'ai une colonne de 35 920 lignes
Je voudrais fusionner les lignes qui ont la même date et donc afficher qu'une fois la date (voir le rendu attendu en photo) avec un code VBA


Sur mon fichier d'origine, j'ai aussi d'autres colonnes avec des noms fournisseurs et n° de commande où je souhaite faire la même chose
je devrais traiter ces 3 colonnes : B, C et D à partir de la ligne 2
Je cherche donc à automatiser cela car j'ai beaucoup de lignes

Si quelqu'un à la solution, merci d'avance
Bonne journée

[patricktoulon]

bonjour
tu veux fusionner les meme ligne en colonne C
tu filtre tes dates en "A" et tu mergecells le offset(0,2) des speciallcells(xlvisible)

[Thautheme]

Bonjour le fil, bonjour le forum,

Une proposition avec le code ci-dessous :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim DL As Long 'déclare la variable DL (Derniere Ligne)
Dim LD As Long 'déclare la variable LD (Ligne du Début)
Dim LF As Long 'déclare la variable LF (Ligne de Fin)
Dim I As Long 'déclare la variable I (Incrément)
Dim D As String 'déclare la variable D (Date)
 
Set O = Worksheets("Feuil1") 'définit l'onglet O (à adapter à ton cas)
DL = O.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A de l'onglet O
O.Columns("B:D").Cells.UnMerge 'défusionne toutes les cellules des colonne B à D
For I = 2 To DL 'boucle 1 : sur toutes les lignes I  de 2 à DL
    If Cells(I - 1, "A").Value <> Cells(I, "A").Value Then 'condition 1 : si la valeur de la cellule au-dessus est différente de la valeur de la cellule de la boucle
        If LF > 0 Then 'condition 2 : si la ligne de fin LF est supérieure à zéro
            For J = 2 To 4 'boucle 2 sur les colonnes 2 à 4 (=> colonne B à D)
                O.Range(O.Cells(LD, J), O.Cells(LF, J)).Merge 'fusionne les cellules des ligne LD à LF dans la colonne de la boucle
            Next J 'prochaine colonne de la boucle 2
            LF = 0 'réinitialise la ligne de fin LF
        End If 'fin de la condition 2
        LD = I 'définit la ligne de début LD
        D = CStr(Cells(I, "A").Value) 'définit la date D
    Else 'sinon (condition 1)
        LF = I 'définit la ligne de fin LF
    End If 'fin de la condition 1
Next I 'prochaine ligne de la boucle 1
End Sub

[patricktoulon]

bonjour tautheme
allons allons!!!

faisons simple

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Sub merge()
    Set f = ActiveSheet
    For i = 1 To 18
        If oldvalue <> f.Cells(i, 1).Value Then f.Cells(i, "C") = f.Cells(i, "A").Text
        oldvalue = f.Cells(i, "A").Text
        With f.Range("$A$1:$A$18")
            .AutoFilter Field:=1, Criteria1:=Cells(i, 1).Value
            .SpecialCells(xlVisible).Offset(0, 2).MergeCells = True
            .AutoFilter
        End With
    Next
End Sub

pettite amélioration le format de date et le merge uniquement si ca n'est pas deja fait

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub merge()
    Set f = ActiveSheet
    For i = 1 To 18
        If oldvalue <> f.Cells(i, 1).Text Then f.Cells(i, "C") = CStr(f.Cells(i, "A").Text): f.Cells(i, "C").NumberFormat = "mm/dd/yyyy"
        oldvalue = CStr(f.Cells(i, "A").Text)
        If f.Cells(i, 3).MergeArea.Cells.Count = 1 Then
            With f.Range("$A$1:$A$18")
                .AutoFilter Field:=1, Criteria1:=Cells(i, 1).Value
                .SpecialCells(xlVisible).Offset(0, 2).MergeCells = True
                .AutoFilter
            End With
        End If
    Next
End Sub

pour l'anegdote
ne pas confondre numberformat="mm/dd/yyyy" et format(une date,"mm/dd/yyyy")
ca n'est pas la meme chose le premier etant un peu magic et n'exprimant son action comme le fait format et redresse le soucis bien conus des dates dans une cellule
d'ailleur dans la 2d capture on voit bien son action qui n'est pas la meme que la fonction format avec les 2d et 3eme date

[Thautheme]

Bonjour le fil, bonjour le forum,

@Patrick
Allons, allons !!

Faire simple c'est bien mais quand ça fonctionne c'est mieux...

[chloe.secli]

Je suis débutante depuis maintenant plusieurs mois en VBA
Mais je n'ai jamais entendu parler de ça : "tu mergecells le offset(0,2) des speciallcells(xlvisible)"
Je n'ai aucune idées de ce que c'est

Je met un échantillon de mon fichier ci-joint

J'ai testé les 2 réponses reçues, aucune ne donnent le bon "résultat"

[Thautheme]

Re,

Mon code comportait une erreur, je le reconnais. Mais si tu donnes un exemple où tes données commencent en colonne A, il ne faut pas s'étonner que ça ne fonctionne pas sur un fichier où elles commencent en colonne B !...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim PLV As Long 'déclare la variable PLV (Première Ligne Vide)
Dim LD As Long 'déclare la variable LD (Ligne du Début)
Dim LF As Long 'déclare la variable LF (Ligne de Fin)
Dim I As Long 'déclare la variable I (Incrément)
Dim D As String 'déclare la variable D (Date)
 
Set O = Worksheets("Feuil1") 'définit l'onglet O (à adapter à ton cas)
PLV = O.Cells(Application.Rows.Count, "B").End(xlUp).Row + 1 'définit la première ligne vide PLV de la colonne B de l'onglet O
O.Columns("B:D").Cells.UnMerge 'défusionne toutes les cellules des colonnes B à D
For I = 2 To PLV 'boucle 1 : sur toutes les lignes I de 2 à PLV
    If Cells(I - 1, "B").Value <> Cells(I, "B").Value Then 'condition 1 : si la valeur de la cellule au-dessus est différente de la valeur de la cellule de la boucle
        If LF > 0 Then 'condition 2 : si la ligne de fin LF est supérieure à zéro
            Application.DisplayAlerts = False
            For J = 2 To 4 'boucle 2 sur les colonnes 2 à 4 (=> colonne B à D)
                O.Range(O.Cells(LD, J), O.Cells(LF, J)).Merge 'fusionne les cellules des ligne LD à LF dans la colonne de la boucle
            Next J 'prochaine colonne de la boucle 2
            LF = 0 'réinitialise la ligne de fin LF
        End If 'fin de la condition 2
        LD = I 'définit la ligne de début LD
        D = CStr(Cells(I, "B").Value) 'définit la date D
    Else 'sinon (condition 1)
        LF = I 'définit la ligne de fin LF
    End If 'fin de la condition 1
Next I 'prochaine ligne de la boucle 1
End Sub

[patricktoulon]

bonjour tautheme

Faire simple c'est bien mais quand ça fonctionne c'est mieux...

et alors ca fonctionne pas dans la capture????

tu imagine ta boucle elle a plus de 30 000 lignes
tu peux chercher tant que tu veux les filtres seront toujours plus rapides
n'oublie pas que tu fusionne tu réenclenche tout les events calculate et compagnie

[chloe.secli]

Yes c'est bon ça marche pour mes 3 colonnes
Merci beaucoup de ton aide Thautheme
Bonne journée

Et merci à toi aussi Patrick