Discussion :

[ti_mouton]

Bonjour,

Grâce au forum CCM, je dispose d'un code pour effectuer un filtre élaboré. Ce code fonctionne très bien, et je remercie à nouveau les membres de CCM qui m'ont aidé. Mon pb aujourd'hui est que j'ai voulu rajouté une ligne me permettant d'appliquer une formule à la colonne K, cette formule renvoie une valeur en fonction des éléments du filtre (qui est copié sur les colonnes de B à J). La formule à appliquer se trouve en K2, et elle doit s'appliquer de la cellule K7 jusqu'à la dernière ligne du filtre (qui est amenée à évoluer). Malheureusement j'ai trop de lacunes en VBA, ce code ne fonctionne pas, je n'ai aucun message d'erreur mais la formule ne s'applique pas...

J'ai vraiment besoin de votre aide, merci à tous ceux qui voudront bien se pencher sur mon pb...

Voici mon code :

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
Sub FiltreAvance()
 
Dim DL As Integer
Dim DerLig As Integer
DL = Sheets(1).Cells(Application.Rows.Count, 4).End(xlUp).Row
DerLig = Sheets(2).Cells(Application.Rows.Count, 2).End(xlUp).Row
With Sheets(1)
    .Select
    .Range(Cells(4, 1), Cells(DL, 9)).Select
End With
Selection.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets(2).[B1:B2], CopyToRange:=Sheets(2).[B6], Unique:=False
With Sheets(2)
    .Select
    Range("B6:J6").Font.Bold = True
    Range("B6:J6").Font.Size = 16
    Range("B6:J6").Font.ColorIndex = 2
    Range("B6:J6").Interior.ColorIndex = 41
    Range("B6:J6").HorizontalAlignment = xlCenter
    Range("F7:J65536").HorizontalAlignment = xlCenter
    Range("B7:E65536").HorizontalAlignment = xlLeft
    .Range("K7" & DerLig).FormulaR1C1 = Range("K2").FormulaR1C1
End With
End Sub

[joe.levrai]

Bonjour,

regarde si c'est une bonne piste, je n'ai pas pu la tester bien entendu

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
Sub FiltreAvance()
Dim Plage As Range
 
With Sheets(1)
    Set Plage = .Range(.Cells(4, 1), .Cells(.Cells(.Rows.Count, 4).End(xlUp).Row, 9))
    Plage.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets(2).[B1:B2], CopyToRange:=Sheets(2).[B6], Unique:=False
End With
 
With Sheets(2)
    With .Range("B6:J6")
        .Font.Bold = True
        .Font.Size = 16
        .Font.ColorIndex = 2
        .Interior.ColorIndex = 41
        .HorizontalAlignment = xlCenter
    End With
 
    .Range("F7:J65536").HorizontalAlignment = xlCenter
    .Range("B7:E65536").HorizontalAlignment = xlLeft
    Set Plage =  .Range(.Cells(7, 11), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 11))
    Plage.FormulaR1C1 = .Cells(2, 11).FormulaR1C1
End With
 
End Sub

Je me suis permis de virer les Select et d'enlever tes variables contenant les dernières lignes
pour une meilleur lisibilité, j'ai par contre utilisé une variable Plage sur le filtre avancé et l'écriture de la formule

[ti_mouton]

J'ai intégré ton code et il a l'air de très bien fonctionner ! Merci beaucoup.

J'ai voulu en profiter pour le réutiliser pour un autre code (un code qui efface le contenu de certaines plage de cellules), malheureusement je n'ai pas du l'adapter comme il faut car il ne marche pas... j'ai le message d'erreur : Variable non définie

Code :

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

1
2
3
4
5
6
7
8
9
10
Sub Effacer()
Dim Plage1 As Range
Dim Plage2 As Range
    With Sheets(2)
        Plage1 = .Range(.Cells(6, 2), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 9))
        Plage1.ClearContents
        Plage2 = .Range(.Cells(7, 10), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 39))
        Plage2.ClearContents
    End With
End Sub

As tu une idée de ce qui ne va pas ?

Merci pour ton aide.

[joe.levrai]

Une variable Objet (Variable Range) s'instancie au moyen de l'instruction Set

par exemple

Code :

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

Set Plage = Feuil1.Range("A1")

[ti_mouton]

Super ça fonctionne, merci beaucoup j'aurais appris des choses grâce à toi.

Je me permets de te solliciter à nouveau si tu le veux bien. Cette macro Effacer prend beaucoup de temps ( au moins 5-6min), je voulais savoir si tu connais un autre type de code, qui serait peut etre plus rapide? De plus, actuellement j'ai deux boutons, je dois d'abord cliquer sur le bouton 1 qui active la macro Effacer, puis je clique sur le bouton 2 qui active ma macro FiltreAvance. Y aurait il un moyen pour regrouper les 2 macros ? l'idéal serait que lorsqu'on clique sur le bouton 2, la macro efface le contenu des 2 plages de cellules mentionnées pour ensuite copie le nouveau filtre et lance l'exécution des formules.

Merci beaucoup pour ton aide.

[joe.levrai]

A vrai dire, j'ai l'impression qu'on peut encore faire mieux dans une seule procédure :

1) Effacement de la totalité de ta feuille de destination
2) écriture de la zone de critère et des en-têtes où tes données seront copiées par le filtre
3) application du filtre

ça paraît radical, mais au moins le nettoyage de feuille va prendre moins d'une seconde

[ti_mouton]

Je ne comprend pas bien, selon toi il ne faut pas passer par VBA ? le soucis c'est qu'à la suite de mon filtre j'ai une dizaine de colonne avec des valeurs calculées grâce aux formules que je renseigne en ligne 2 ... Si j'efface toute ma feuille manuellement et que je réecri tout ça n'est pas très pratique...

[joe.levrai]

Non, ma proposition était intégralement géré dans une seule procédure VBA

cependant, mon impression était fausse car tu as d'autres données que tu souhaites visiblement conserver

ton explication répond à la question : pourquoi c'est si long

si tu as des tonnes de formules, c'est peut être le recalcule de la feuille qui ralenti le processus ?

essaye ainsi, j'en ai profité pour tout rassembler dans une seule procédure :

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
Sub EffaceEtFiltre()
Dim Plage As Range
 
'neutralise le recalcule
Application.Calculation = xlCalculationManual
With Sheets(2)
    ' regroupement de tes deux plages dans une seule
    Set Plage = Union(.Range(.Cells(6, 2), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 9)), .Range(.Cells(7, 10), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 39)))
 
    'effacement des deux plage
    Plage.ClearContents
End With
'remise en place du recalcule automatique
Application.Calculation = xlCalculationAutomatic
 
' partie liée au filtre avancé
With Sheets(1)
    Set Plage = .Range(.Cells(4, 1), .Cells(.Cells(.Rows.Count, 4).End(xlUp).Row, 9))
    Plage.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets(2).[B1:B2], CopyToRange:=Sheets(2).[B6], Unique:=False
End With
 
With Sheets(2)
    With .Range("B6:J6")
        .Font.Bold = True
        .Font.Size = 16
        .Font.ColorIndex = 2
        .Interior.ColorIndex = 41
        .HorizontalAlignment = xlCenter
    End With
 
    .Range("F7:J65536").HorizontalAlignment = xlCenter
    .Range("B7:E65536").HorizontalAlignment = xlLeft
    Set Plage = .Range(.Cells(7, 11), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 11))
    Plage.FormulaR1C1 = .Cells(2, 11).FormulaR1C1
End With
 
End Sub

[ti_mouton]

Ah ok, pardon je t'avais mal compris.

Je viens d'essayer ton code, le filtre marche bien, seul pb mes formules (inscrites dans les cellules de K2 à AN2) ont été effacées aussi du coup je n'ai plus mes valeur calculées.

Pourtant les plages à effacer ont bien été renseignées et n'incluent pas les cellules de K2 à AN2 ... C'est bizzare.

[joe.levrai]

Pour ta question des formules effacées, j'ai peur de ne pouvoir deviner, je ne sans pas comment sont agencées tes données
le comportement provient de ce que contient ta colonne B (c'est sur elle qu'on calcule les lignes dynamiquement)

essaye ce code :

Code :

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

1
2
3
4
5
6
7
With Sheets(2)
    ' regroupement de tes deux plages dans une seule
    Set Plage = Union(.Range(.Cells(6, 2), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 9)), .Range(.Cells(7, 10), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 39)))
 
    ' affiche l'adresse de la plage
    MsgBox Plage.Address
End With

et regarde l'adresse de la plage pour vérifier que tes colonnes calculées ne sont pas dedans

[ti_mouton]

Génialissime ça fonctionne !!! Il y avait en effet une petite erreur au niveau de la plage à effacer, j'étais passé à coté tout à l'heure.

Un très très grand merci pour toute ton aide !