XL 2013 AMELIORATION MACRO DOUBLECLICK ET FILTRES

THIERRY35

XLDnaute Occasionnel
Bonjour,

je finalise un reporting, la macro "doubleclick" étant en partie installée sur la feuille.
Elle ne fonctionne que partiellement

Le tableau recense le nombre de contrats terminés ou venant à échéance dans 30 j, ou 30 à 60 j et 60 à 90.

On double clique sur l'un des chiffres et on accède à la liste des contrats correspondants par une série de filtres : région ou ville, période d'échéance.
mais je suis bloqué sur deux problèmes ;
- le 1er critère critere1 = Cells(9, Target.Column), (région ou ville) ne se trouve pas dans la même colonne dans la base
- je ne sais pas écrire le code qui correspond au filtre entre 30 et 60 jours et entre 61 et 90 j

Ci-joint extrait du tableau.

Merci de votre aide
 

Pièces jointes

  • MODELE2.xlsm
    357.9 KB · Affichages: 53

phlaurent55

Nous a quittés en 2020
Repose en paix
Bonjour Thierry,


aller chercher les critères avant de changer de feuille serait sans doute un peu plus logique


Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Not Application.Intersect(Target, Range("B13:G17")) Is Nothing Then
  critere1 = Cells(9, Target.Column)
  critere2 = Cells(1, 2)
 
Sheets("BASE").Select

ActiveSheet.Range("$A$1:$E$10000").AutoFilter Field:=2, Criteria1:=critere1
ActiveSheet.Range("$A$1:$E$10000").AutoFilter Field:=5, Criteria1:=critere2
     
End If

End Sub

à+
Philippe
 

THIERRY35

XLDnaute Occasionnel
Bonjour phlaurent55,
je m'étais inspiré d'un code de Pierrejean d'une autre discussion.
ton code fonctionne également mais toujours que sur le critère "région"
je modifie ton code (critère1 et rajoute un code pour la colonne correspond à une région)
mais ça risque de devenir laborieux à écrire
Y a t il moyen pour le simplifier ?
Merci
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Not Application.Intersect(Target, Range("B13:G17")) Is Nothing Then
critere1 = Cells(9, 2)
critere2 = Cells(1, 2)

Sheets("BASE").Select

ActiveSheet.Range("$A$1:$E$10000").AutoFilter Field:=2, Criteria1:=critere1
ActiveSheet.Range("$A$1:$E$10000").AutoFilter Field:=5, Criteria1:=critere2


End If

If Not Application.Intersect(Target, Range("B13:G17")) Is Nothing Then
critere1 = Cells(9, 3)
critere2 = Cells(1, 2)

Sheets("BASE").Select

ActiveSheet.Range("$A$1:$E$10000").AutoFilter Field:=3, Criteria1:=critere1
ActiveSheet.Range("$A$1:$E$10000").AutoFilter Field:=5, Criteria1:=critere2

End If



End Sub

Merci
 

phlaurent55

Nous a quittés en 2020
Repose en paix
Re,

peut-être comme ceci mais vérifie les lignes en rouge


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Not Application.Intersect(Target, Range("B13:G17")) Is Nothing Then
critere1 = Cells(9, 2)
critere2 = Cells(1, 2)
critere3 = Cells(9, 3)


Sheets("BASE").Select
ActiveSheet.Range("$A$1:$E$10000").AutoFilter Field:=2, Criteria1:=critere1

ActiveSheet.Range("$A$1:$E$10000").AutoFilter Field:=5, Criteria1:=critere2

ActiveSheet.Range("$A$1:$E$10000").AutoFilter Field:=3, Criteria1:=critere3


End If

End Sub

à+
Philippe
 

Statistiques des forums

Discussions
312 905
Messages
2 093 469
Membres
105 740
dernier inscrit
Mln