Macro evenementielle sur filtre couleur

Jiheme

XLDnaute Accro
Bonjour

Je n'arrive pas à faire fonctionner cette macro.

La cellule C1 provoque une MFC et je souhaite que seules apparaissent les lignes colorées par cette MFC et qu'il en soit ainsi à chaque changement de C1.

Merci

A+
 

Pièces jointes

  • test filtre.xlsm
    60.2 KB · Affichages: 40
  • test filtre.xlsm
    60.2 KB · Affichages: 43

david84

XLDnaute Barbatruc
Re : Macro evenementielle sur filtre couleur

Bonjour,
place le terme "recoit" en C1, le menu déroulant des clubs en C2 et modifie la macro comme suit :
Code:
Private Sub Worksheet_change(ByVal Target As Range)
If Target.Address = "$C$2" Then
    Application.ScreenUpdating = False
    Range("B3:G383").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
    Range("C1:C2"), Unique:=False
    Application.ScreenUpdating = True
End If
End Sub
A+
 

Jiheme

XLDnaute Accro
Re : Macro evenementielle sur filtre couleur

Bonjour David, re à tous

Cela ne fonctionne pas du tout quelque soit le choix en C2 cela laisse la ligne 3 et rien d'autre.
Au risque d'être exigeant, j'aimerai aussi savoir pourquoi la mienne ne fonctionne pas...
Merci
A+
 

job75

XLDnaute Barbatruc
Re : Macro evenementielle sur filtre couleur

Bonjour Jiheme, David :)

Pas regardé la 2ème solution de David, voici la mienne :

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C1]) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Rows.Hidden = False
If IsEmpty([C1]) Then Exit Sub
On Error Resume Next
With [IV3].Resize(Application.Count([B:B]))
  .FormulaR1C1 = "=LN(AND(RC3<>R1C3,RC7<>R1C3))"
  .SpecialCells(xlCellTypeFormulas, 1).EntireRow.Hidden = True
  .ClearContents
End With
End Sub
Fichier joint.

A+
 

Pièces jointes

  • test filtre(1).xls
    140.5 KB · Affichages: 47

job75

XLDnaute Barbatruc
Re : Macro evenementielle sur filtre couleur

Re,

On peut comme David utiliser le filtre avancé (élaboré) :

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C1]) Is Nothing Then Exit Sub
Dim h&
h = Application.Count([B:B])
If IsEmpty([C1]) Or h = 0 Then On Error Resume Next: ShowAllData: Exit Sub
Application.ScreenUpdating = False
[IV3] = "=OR(C3=C$1,G3=C$1)"
[B2:G2].Resize(h + 1).AdvancedFilter xlFilterInPlace, [IV2:IV3]
[IV3] = ""
End Sub
Fichier (2).

Edit : ici aussi il vaut mieux utiliser Application.ScreenUpdating = False

A+
 

Pièces jointes

  • test filtre(2).xls
    141 KB · Affichages: 41
Dernière édition:

Discussions similaires

Réponses
4
Affichages
455

Membres actuellement en ligne

Statistiques des forums

Discussions
312 084
Messages
2 085 194
Membres
102 814
dernier inscrit
JLGalley