Filtre automatique pour Userform Multipage

Le 12/12/2014 à 13:17

Bonjour,

Je réalise un USF qui me sert de récapitulatif d'une base de données.

Je crée 2 macros quasi identique qui utilisent un filtre automatique.

Macro 1:

Private Sub PRIMESTERME()
Dim ANNEE As Integer
Dim ANNEE_PREC As Integer
Dim NoDerLigne As Integer
Dim TableauNPREC(1 To 12) As Double 'tableau des 12 mois
Dim TableauN(1 To 12) As Double 'tableau des 12 mois
Dim ChoixFeuille As Worksheet 'Choix de la feuille
Dim NoLigne As Integer
Dim NoMoisNPREC As Integer
Dim MontantNPREC As Double
Dim NoMoisN As Integer
Dim MontantN As Double

Dim I As Integer
Dim MOIS As Integer
Dim datedebnprec As Date
Dim datefinnprec As Date
Dim datedebn As Date
Dim datefinn As Date

ANNEE = Sheets("Accueil").Range("AQ1").Value
ANNEE_PREC = ANNEE - 1
Set ChoixFeuille = Worksheets("PRIMES")

'dernière ligne de l'onglet base base
NoDerLigne = ChoixFeuille.Range("A" & Rows.Count).End(xlUp).Row

Selection.AutoFilter
Selection.AutoFilter Field:=9, Criteria1:="Terme"

'On definit les mois de l'année N-1
For MOIS = 1 To 12
datedebnprec = DateSerial(ANNEE_PREC, MOIS, 1)
datefinnprec = DateSerial(ANNEE_PREC, MOIS + 1, 1)
datedebn = DateSerial(ANNEE, MOIS, 1)
datefinn = DateSerial(ANNEE, MOIS + 1, 1)

'Calcul pour l'Année N-1
For NoLigne = 2 To NoDerLigne
If ChoixFeuille.Range("AC" & NoLigne) >= datedebnprec And ChoixFeuille.Range("AC" & NoLigne) < datefinnprec Then
'parcours de toutes les lignes de l'onglet base
NoMoisNPREC = Month(ChoixFeuille.Range("AC" & NoLigne).Value)
MontantNPREC = ChoixFeuille.Range("D" & NoLigne).Value
TableauNPREC(NoMoisNPREC) = TableauNPREC(NoMoisNPREC) + MontantNPREC
End If
Next NoLigne

'Calcul por l'année N
For NoLigne = 2 To NoDerLigne
If ChoixFeuille.Range("AC" & NoLigne) >= datedebn And ChoixFeuille.Range("AC" & NoLigne) < datefinn Then
'parcours de toutes les lignes de l'onglet base
NoMoisN = Month(ChoixFeuille.Range("AC" & NoLigne).Value)
MontantN = ChoixFeuille.Range("D" & NoLigne).Value
TableauN(NoMoisN) = TableauN(NoMoisN) + MontantN
End If
Next NoLigne
Next MOIS

'écriture du résultat N-1
For I = 1 To 12
Controls("TextBox" & I + 25).Value = TableauNPREC(I)
Controls("TextBox" & I + 25) = Format(Controls("TextBox" & I + 25), "### ### ##0")
Next I

'écriture du résultat N
For I = 1 To 12
Controls("TextBox" & I + 169).Value = TableauN(I)
Controls("TextBox" & I + 169) = Format(Controls("TextBox" & I + 169), "### ### ##0")
Next I

ChoixFeuille.AutoFilterMode = False

Set ChoixFeuille = Nothing

End Sub

Macro 2:

Private Sub PRIMESAN()
Dim ANNEE As Integer
Dim ANNEE_PREC As Integer
Dim NoDerLigne As Integer
Dim TableauNPREC(1 To 12) As Double 'tableau des 12 mois
Dim TableauN(1 To 12) As Double 'tableau des 12 mois
Dim ChoixFeuille As Worksheet 'Choix de la feuille
Dim NoLigne As Integer
Dim NoMoisNPREC As Integer
Dim MontantNPREC As Double
Dim NoMoisN As Integer
Dim MontantN As Double

Dim I As Integer
Dim MOIS As Integer
Dim datedebnprec As Date
Dim datefinnprec As Date
Dim datedebn As Date
Dim datefinn As Date

ANNEE = Sheets("Accueil").Range("AQ1").Value
ANNEE_PREC = ANNEE - 1
Set ChoixFeuille = Worksheets("PRIMES")

'dernière ligne de l'onglet base base
NoDerLigne = ChoixFeuille.Range("A" & Rows.Count).End(xlUp).Row

Selection.AutoFilter
Selection.AutoFilter Field:=9, Criteria1:="Affaire nouvelle"

'On definit les mois de l'année N-1
For MOIS = 1 To 12
datedebnprec = DateSerial(ANNEE_PREC, MOIS, 1)
datefinnprec = DateSerial(ANNEE_PREC, MOIS + 1, 1)
datedebn = DateSerial(ANNEE, MOIS, 1)
datefinn = DateSerial(ANNEE, MOIS + 1, 1)

'Calcul pour l'année N-1
For NoLigne = 2 To NoDerLigne
If ChoixFeuille.Range("AC" & NoLigne) >= datedebnprec And ChoixFeuille.Range("AC" & NoLigne) < datefinnprec Then
'parcours de toutes les lignes de l'onglet base
NoMoisNPREC = Month(ChoixFeuille.Range("AC" & NoLigne).Value)
MontantNPREC = ChoixFeuille.Range("D" & NoLigne).Value
TableauNPREC(NoMoisNPREC) = TableauNPREC(NoMoisNPREC) + MontantNPREC
End If
Next NoLigne

'Calcul pour l'année N
For NoLigne = 2 To NoDerLigne
If ChoixFeuille.Range("AC" & NoLigne) >= datedebn And ChoixFeuille.Range("AC" & NoLigne) < datefinn Then
'parcours de toutes les lignes de l'onglet base
NoMoisN = Month(ChoixFeuille.Range("AC" & NoLigne).Value)
MontantN = ChoixFeuille.Range("D" & NoLigne).Value
TableauN(NoMoisN) = TableauN(NoMoisN) + MontantN
End If
Next NoLigne
Next MOIS

'écriture du résultat N-1
For I = 1 To 12
Controls("TextBox" & I + 37).Value = TableauNPREC(I)
Controls("TextBox" & I + 37) = Format(Controls("TextBox" & I + 37), "### ### ##0")
Next I

'écriture du résultat N
For I = 1 To 12
Controls("TextBox" & I + 181).Value = TableauN(I)
Controls("TextBox" & I + 181) = Format(Controls("TextBox" & I + 181), "### ### ##0")
Next I

ChoixFeuille.AutoFilterMode = False

Set ChoixFeuille = Nothing

End Sub

Entre les 2 macros, seul le critère change.

On passe de

Selection.AutoFilter Field:=9, Criteria1:="Terme"

à

Selection.AutoFilter Field:=9, Criteria1:="Affaire nouvelle"

J'utilise un multipage.

Lorsque je lance les macros, j'obtiens le même résultat sur la Page 1 et la Page 2, alors que les critères sont différents.

Le résultat de la page 1 est correct. C'est celui de la page 2 qui ne correspond pas au résultat attendu.

Aurais je zappé une une étape ?

Autre point qui m'intrigue.

Si je supprime la macro 1 et que je ne lance que la macro 2, j'obtiens le résultat de la macro 1.

Le code pour le filtre automatique est-il bien rédigé ?

Peut-on faire plusieurs filtres automatique sur une même feuille ?

Merci pour vos conseils.

Le 12/12/2014 à 14:35

Bonjour

J'ai vite survolé ton 1er code

Un truc qui me titille

Tu fais un filtre

Selection.AutoFilter Field:=9, Criteria1:="Terme"

Ensuite tu ne tiens pas compte du filtre

For NoLigne = 2 To NoDerLigne

Tu parcours toutes les lignes qu'elles soient filtrées ou pas

Une idée comme cela

Tu filtres la colonne 9 par ton critère "Terme" et tu filtres la colonne AC par tes dates

Ensuite tu récupères les données que des cellules visibles

Sans fichier c'est tout ce que peux faire

Le 13/12/2014 à 03:24

Bonjour,

Effectivement, je n'ai pas fait attention à la numérotation des lignes.

J'ai suivi ton idée.

Je suis passé par un filtre élaboré pour copier le résultat dans une autre feuille et c'est sur cette nouvelle feuille que j'applique ma macro.

Merci du conseil.

Cordialement

Rechercher des sujets similaires à "filtre automatique userform multipage"