Macro pour grouper des lignes sur une plage qui peut varier

**girardinho** · 20/07/2010, 11h52

Bonjour à tous

Je reviens vers vous pour trouver une solution à un problème qui me tourmente depuis quelques jours.

Je dois en effet grouper mes lignes en fonctions de nom qu'il y a dans plusieurs colonnes. Voir la capture d'écran pour que ça soit plus clair.

Mes lignes que je dois grouper sont elles même séparé par des lignes jaunes et vertes qui sont mes sous totaux.
Je dois dans un premier temps grouper les lignes en fonction du nom en colonne B (ex: ici pour Clairfayt groupement des Lignes 2 à 5; pour Gilibert des lignes 7 à 9 et ainsi de suite...). La ligne jaune restera donc apparente.

Dans un second temps, je dois effectuer un groupement en fonction de la ville en colonne C. Pour Bordeaux je devrai donc grouper de la ligne 2 à 13.
La ligne verte restera apparente mais plus la ligne jaune qui sera désormais grouper à l'intérieur.

Les données varient d'un mois à l'autre, ainsi le groupement de Clairfayt se fera des lignes 2 à 18 sur un mois, 2 à 42 sur un autre etc... etc...

Je ne sais pas si je me suis bien exprimé mais j'aurai vraiment besoin de votre aide pour résoudre une bonne fois pour toute ce problème et voir comment l'on procède.

merci à tous

**mayekeul** · 20/07/2010, 14h58

bonjour,

je peux me tromper, mais si j'ai bien cerné ton problème.

un début de solution serait peut être un code dans le genre:

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
 
Sub GroupAndColorize()
Dim C As Range, CE As Integer
 
'remplacer "A:E" par le colonnes de ton tableau
'Array(3,2) pour colonne(3)("DR") et ensuite colonne(2)("Nom ZMQS")
'array(4,5) pour le sous-total pour commandes et passages
 
Columns("A:E").Subtotal Array(3, 2), xlSum, Array(4, 5), False, True, xlSummaryBelow 
 
 
For Each C In Columns(1).Cells
    If C = "" Then
        If Not C.Offset(0, 1) = "" Then Rows(C.Row).Interior.Color = 65535
        If Not C.Offset(0, 2) = "" Then Rows(C.Row).Interior.Color = 5296274
        CE = CE + 1
    End If
    If CE = 10 Then Exit Sub
Next
 
End Sub

**girardinho** · 20/07/2010, 16h32

Décidememnt mayekeul tu es mon sauveur attitré...

Oui ça pourrait fonctionner avec les sous totaux comme ça aussi je pense mais j'ai déjà une partie de ma macro qui s'ocupe de l'insertion de ces sous totaux et de leur coloration.
Mais du coup je ne sais pas comment faire pour juste intégrer le groupement:

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
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
Sheets("Tableau").Select
 
Dim N As Range, V As Range
Dim I, Posit3, Posit5
 
For I = Cells(1, 1).End(xlDown).Row To 3 Step -1
    Set N = Cells(I, 3)
    Set V = Cells(I, 5)
    If Not N.Offset(-1, 0) = N Then
        If Not V.Offset(-1, 0) = V Then V.EntireRow.Insert
        N.EntireRow.Insert
    Else
        If Not V.Offset(-1, 0) = V Then
               V.EntireRow.Insert
'               V.Resize(2, 1).EntireRow.Insert
        End If
    End If
 
Next I
 
Posit5 = 1
Posit3 = 1
ancien = Cells(1, 3).Value
For I = 1 To Cells(65536, 3).End(xlUp).Row + 1
 
    If Cells(I, 3).Value = "" Then
        ok = ajout_formule(I, 6, Posit5)
        ok = ajout_formule(I, 7, Posit5)
        ok = ajout_formule(I, 9, Posit5)
        ok = ajout_formule(I, 11, Posit5)
        ok = ajout_formule(I, 13, Posit5)
        ok = ajout_formule(I, 15, Posit5)
        ok = ajout_formule(I, 17, Posit5)
        ok = ajout_formule(I, 19, Posit5)
        ok = ajout_formule(I, 21, Posit5)
        ok = ajout_formule(I, 23, Posit5)
        ok = ajout_formule(I, 25, Posit5)
        ok = ajout_formule(I, 27, Posit5)
        ok = ajout_formule(I, 29, Posit5)
        ok = ajout_formule(I, 31, Posit5)
        ok = ajout_formule(I, 33, Posit5)
        ok = ajout_formule(I, 35, Posit5)
        ok = ajout_formule(I, 37, Posit5)
        ok = ajout_formule(I, 39, Posit5)
        ok = ajout_formule(I, 41, Posit5)
        ok = ajout_formule(I, 43, Posit5)
        ok = ajout_formule(I, 45, Posit5)
        Rows(I).Interior.ColorIndex = 6
 
        If Cells(I + 1, 3).Value = "" Then
            ok = ajout_formule(I + 1, 6, Posit3)
            ok = ajout_formule(I + 1, 7, Posit3)
            ok = ajout_formule(I + 1, 9, Posit3)
            ok = ajout_formule(I + 1, 11, Posit3)
            ok = ajout_formule(I + 1, 13, Posit3)
            ok = ajout_formule(I + 1, 15, Posit3)
            ok = ajout_formule(I + 1, 17, Posit3)
            ok = ajout_formule(I + 1, 19, Posit3)
            ok = ajout_formule(I + 1, 21, Posit3)
            ok = ajout_formule(I + 1, 23, Posit3)
            ok = ajout_formule(I + 1, 25, Posit3)
            ok = ajout_formule(I + 1, 27, Posit3)
            ok = ajout_formule(I + 1, 29, Posit3)
            ok = ajout_formule(I + 1, 31, Posit3)
            ok = ajout_formule(I + 1, 33, Posit3)
            ok = ajout_formule(I + 1, 35, Posit3)
            ok = ajout_formule(I + 1, 37, Posit3)
            ok = ajout_formule(I + 1, 39, Posit3)
            ok = ajout_formule(I + 1, 41, Posit3)
            ok = ajout_formule(I + 1, 43, Posit3)
            ok = ajout_formule(I + 1, 45, Posit3)
 
 
            Rows(I + 1).Interior.ColorIndex = 4
 
            Posit3 = I + 2
            Posit5 = I + 2
            I = I + 1
        Else
            Posit5 = I + 1
        End If
    End If
 
Next I
 
'
End Sub

Je me doute qu'il faut intégrer selection.rows.group mais je ne sais pas a quel moment le placer pour qu'il prenne en compte le côté "variable" de la chose...

**mayekeul** · 22/07/2010, 08h44

euh a chaud comme ça, je dirais là

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
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
 
Sub test()
Sheets("Tableau").Select
 
Dim N As Range, V As Range
Dim I, Posit3, Posit5
Dim LastPos
 
For I = Cells(1, 1).End(xlDown).Row To 3 Step -1
    Set N = Cells(I, 3)
    Set V = Cells(I, 5)
    If Not N.Offset(-1, 0) = N Then
        If Not V.Offset(-1, 0) = V Then V.EntireRow.Insert
        N.EntireRow.Insert
    Else
        If Not V.Offset(-1, 0) = V Then
               V.EntireRow.Insert
'               V.Resize(2, 1).EntireRow.Insert
        End If
    End If
 
Next I
 
Posit5 = 1
Posit3 = 1
ancien = Cells(1, 3).Value
LastPos = 1
For I = 1 To Cells(65536, 3).End(xlUp).Row + 1
 
    If Cells(I, 3).Value = "" Then
        Rows(LastPos & ":" & I).Rows.Group
        ok = ajout_formule(I, 6, Posit5)
        ok = ajout_formule(I, 7, Posit5)
        ok = ajout_formule(I, 9, Posit5)
        ok = ajout_formule(I, 11, Posit5)
        ok = ajout_formule(I, 13, Posit5)
        ok = ajout_formule(I, 15, Posit5)
        ok = ajout_formule(I, 17, Posit5)
        ok = ajout_formule(I, 19, Posit5)
        ok = ajout_formule(I, 21, Posit5)
        ok = ajout_formule(I, 23, Posit5)
        ok = ajout_formule(I, 25, Posit5)
        ok = ajout_formule(I, 27, Posit5)
        ok = ajout_formule(I, 29, Posit5)
        ok = ajout_formule(I, 31, Posit5)
        ok = ajout_formule(I, 33, Posit5)
        ok = ajout_formule(I, 35, Posit5)
        ok = ajout_formule(I, 37, Posit5)
        ok = ajout_formule(I, 39, Posit5)
        ok = ajout_formule(I, 41, Posit5)
        ok = ajout_formule(I, 43, Posit5)
        ok = ajout_formule(I, 45, Posit5)
        Rows(I).Interior.ColorIndex = 6
 
        If Cells(I + 1, 3).Value = "" Then
            Rows(LastPos & ":" & I + 1).Rows.Group
            ok = ajout_formule(I + 1, 6, Posit3)
            ok = ajout_formule(I + 1, 7, Posit3)
            ok = ajout_formule(I + 1, 9, Posit3)
            ok = ajout_formule(I + 1, 11, Posit3)
            ok = ajout_formule(I + 1, 13, Posit3)
            ok = ajout_formule(I + 1, 15, Posit3)
            ok = ajout_formule(I + 1, 17, Posit3)
            ok = ajout_formule(I + 1, 19, Posit3)
            ok = ajout_formule(I + 1, 21, Posit3)
            ok = ajout_formule(I + 1, 23, Posit3)
            ok = ajout_formule(I + 1, 25, Posit3)
            ok = ajout_formule(I + 1, 27, Posit3)
            ok = ajout_formule(I + 1, 29, Posit3)
            ok = ajout_formule(I + 1, 31, Posit3)
            ok = ajout_formule(I + 1, 33, Posit3)
            ok = ajout_formule(I + 1, 35, Posit3)
            ok = ajout_formule(I + 1, 37, Posit3)
            ok = ajout_formule(I + 1, 39, Posit3)
            ok = ajout_formule(I + 1, 41, Posit3)
            ok = ajout_formule(I + 1, 43, Posit3)
            ok = ajout_formule(I + 1, 45, Posit3)
 
 
            Rows(I + 1).Interior.ColorIndex = 4
 
            Posit3 = I + 2
            Posit5 = I + 2
            I = I + 1
        Else
            Posit5 = I + 1
        End If
        LastPos = I
    End If
Next I
 
End Sub

**girardinho** · 23/07/2010, 10h04

ça ne marche pas. ça groupe effectivement des lignes mais de façon anarchique. Damned!

**mayekeul** · 23/07/2010, 10h19

bonjour,

dans le code que tu as donnée

tu as donnée tout le code, ou ce n'est qu'une partie???

**girardinho** · 26/07/2010, 09h43

Le code que j'ai donné n'est qu'une partie de la macro mais c'est la partie qui me sert à insérer une ligne lorsque le nom dans la colonne "ZMQS" change et insérer 2 lignes lorsque la ville dans la colonne "DR" change. Les couleurs sont également modifié.
J'ai également la formule qui me calcule mes sous totaux sur les colonnes dédiées.

Macro pour grouper des lignes sur une plage qui peut varier

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager