[XL-2003] Créer un bouton filtre sans doublon avec cellule protégée [Résolu]

[sevy1]

Bonsoir à tous
Je suis entrain de créer une base qui probablement aura au moins 15000 lignes elle comporte comme identifiant le numéro de la déclaration.
A un numéro de déclaration correspond un numéro de sommier et un ou plusieurs numéro d'apurements voir exemple joint
les cellules contenant les formules doivent être vérouillées car cette base sera partagée mais ce que je veux c'est créer
1- un bouton qui filtre les sommiers ( SANS DOUBLON) en cours dont la date d'écheance arrivera à terme (par rapport à la date du jour) dans un mois ou une durée quelconque
2- un bouton qui filtre tous les sommiers (SANS DOUBLON) dont l'échéance est depassée
3- un bouton qui filtre tous les sommiers soldés (SANS DOUBLON) sachant que tout sommier doit porter une des lettre suivante (S, E, D) dans les cas suivants:
E= encours (montant à apurer est supérieur à 0 et date échéance non dépassée par rapport à la date du jour)
S= SOLDE (montant à apurer est nul) dans ce cas tous les doublons de ce sommier doivent porter la lettre S
D= Dépassé (montant à apurer est supérieur à 0 et date échéance dépassée par rapport à la date du jour) cette colonne doit me donner le résultat en colonne Q
Merci pour votre aide

[sevy1]

Bonjour à Tous
Juste pour savoir si mon problème est bien posé (compréhensible)

[Daniel.C]

Bonjour,

Ce qui me gêne, dans ta demande, c'est qu'ici, tu es dans un forum d'entraide, principalement pour aider les participants à progresser dans leurs connaissances Excel. J'ai l'impression désagréable de recevoir un cahier des charges et d'avoir à livrer une appli clé en main sans savoir si tu es intéressé par VBA. Personnellement, je mets ta question sous la pile.

[Daniel.C]

1- un bouton qui filtre les sommiers ( SANS DOUBLON) en cours dont la date d'écheance arrivera à terme (par rapport à la date du jour) dans un mois ou une durée quelconque

Est-ce que tu veux dire date d'échéance égale ou inférieure à 1 mois ?

[sevy1]

Bonjour
Merci tout d'abord d'avoir eu le temps de lire mon problème. Je souhaiterais juste apporter une petite précision. quand j'ai decouvert ce forum j'étais hyper nul dans excel à force de lire les tutos et les problèmes posés par les autres j'ai beaucoup appris et ce qui me permet de comprendre quelques formules car excel est incontournable pour moi j'y travail chaque jour.
Je suis très interessé par le VBA mais je ne comprends rien pour le moment et je veux bien comprendre.
Pour ma demande je veux pouvoir en un clique avoir les sommiers dont la date d'échéance arrivera à échéance dans un mois (date d'échéance égale ou inférieure à 1 mois ).
Merci pour votre aide.

[Daniel.C]

La partie la plus longue, c'est la mise à jour des codes E, S, D en colonne Q si elle doit s'exécuter sur 15000 lignes. J'ai mis une macro qui le fait à l'ouverture du classeur si la date en R1 (que j'ai ajoutée) est inférieure à la date du jour. Ainsi, la macro ne s'exécute qu'une fois par jour. Je joins le classeur pour que tu puisses tester cette partie. Sinon, il n'y a que le premier bouton et le dernier (que j'ai ajouté pour effacer les filtres) qui soient fonctionnels.

Code :

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
Private Sub Workbook_Open()
    Dim Plage As Range, c As Range, Plage1 As Range, Dico As Object
    Application.ScreenUpdating = False
    If [Feuil1!R1] < Date Then
        [Feuil1!R1] = Date
        Set Dico = CreateObject("Scripting.Dictionary")
        With Sheets("Feuil1")
            Set Plage = .Range(.[Q3], .Cells(.Rows.Count, 1).End(xlUp))
            .AutoFilterMode = False
            Plage.AutoFilter 6, ">=" & Format(Date, "mm/dd/yyyy")
            Plage.AutoFilter 15, ">0"
            Set Plage1 = Plage.Offset(1, 16).Resize(Plage.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
            Plage1.Value = "E"
            Plage.AutoFilter 6, "<" & Format(Date, "mm/dd/yyyy")
            Set Plage1 = Plage.Offset(1, 16).Resize(Plage.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
            Plage1.Value = "D"
            Plage.AutoFilter
            Plage.AutoFilter 15, "=0"
            Set Plage1 = Plage.Offset(1).Resize(Plage.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
            For Each c In Plage1
                If Not Dico.exists(c.Value) Then
                    Dico.Add c.Value, c.Value
                End If
            Next c
            Set Plage = .Range(.[Q3], .Cells(.Rows.Count, 1).End(xlUp))
            For Each Item In Dico.items
            .AutoFilterMode = False
            Set Plage = .Range(.[Q3], .Cells(.Rows.Count, 1).End(xlUp))
            Plage.AutoFilter 1, Item
            Set Plage1 = Plage.Offset(1, 16).Resize(Plage.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
            Plage1.Value = "S"
            Next Item
            .AutoFilterMode = False
        End With
    End If
    Application.ScreenUpdating = True
End Sub

Code du premier bouton :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Private Sub CommandButton1_Click()
    'date d'échéance à moins d'un mois et encours=E
    Dim Plage As Range, Tabl1, Tabl2(), c As Range, Dico As Object, Cache As Range
    Application.ScreenUpdating = False
    Set Plage = Range([Q3], Cells(Rows.Count, 1).End(xlUp))
    ActiveSheet.AutoFilterMode = False
    Plage.AutoFilter 17, "=E"
    Plage.AutoFilter 6, "<=" & Format(Date + 31, "mm/dd/yyyy")
    If Plage.Areas.Count > 1 Then
        Set Dico = CreateObject("Scripting.Dictionary")
        Set Plage = Plage.Offset(1).Resize(Plage.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
        For Each c In Plage
            If Not Dico.exists(c.Value) Then
                Dico.Add c.Value, c.Value
            ElseIf Cache Is Nothing Then
                Set Cache = c
            Else
                Set Cache = Union(Cache, c)
            End If
        Next c
        Cache.EntireRow.Hidden = True
    End If
    Application.ScreenUpdating = True
End Sub

Code du quatrième bouton :

Code :

1
2
3
Private Sub CommandButton4_Click()
    ActiveSheet.AutoFilterMode = False
End Sub

Je documenterai le code quand les tests seront finis.

[sevy1]

Bonjour
Merci pour votre proposition et votre diligence. N'auriez vous pas oublier de joindre le classeur comme vous l'aviez souligné dans votre mail.

[Daniel.C]

Bonjour,

(ça arrive même aux meilleurs; mon fils ajoute : aux plus mauvais aussi.)

[sevy1]

Bonjour
(ça arrive même aux meilleurs; mon fils ajoute : aux plus mauvais aussi.) il refléchit dejà comme un programmeur (car n'oublie aucun cas)

Merci pour le fichier j'ai essayé en regardant vos codes de faire fonctionner le bouton 2 et 3 mais voici quelques difficultés rencontrées (juste pour rappeler que je suis hyper nul en VB mais je suis interessé)
1- Lorsque je clique sur le bouton 1, 2 ou 3 j'ai le bon résultat mais si par hasard je clique de nouveau sur un de ces trois boutonsavant de cliquer sur le bouton RAZ le resultat n'est plus identique.
2- Lors du filtre les doublons sur le numéro sommier (colonne A) aparaissent toujours or je voudrais faire apparaitre le dernier numéro du sommier

Pour la première macro est ce qu'il faut la joindre à un bouton ou elle s'excute automatiquement une fois par jour à l'ouverture du fichier? Je n'ai pas pu la tester. ci joint le fichier
Merci

[Daniel.C]

Bonjour,

Code :

Pour la première macro est ce qu'il faut la joindre à un bouton ou elle s'excute automatiquement une fois par jour à l'ouverture du fichier?

Une fois par jour, à l'ouverture du fichier. Je vais rajouter un bouton pour faire le recalcul en cas de besoin. Je te retourne le classeur dans l'après-midi, sauf empêchement.

[sevy1]

Bonjour
Dans cette attente merci

[Daniel.C]

Voila le classeur modifié.

[sevy1]

Bonsoir
C'est génial infinement merci pour tout votre disponibilité et solutions proposées.