Appliquer plusieurs filtres automatiques sur une base (2)

[apt]

Bonsoir à tous,

Je reviens avec le même sujet une deuxième fois, mais avec un fichier en PJ ou j'ai expliqué avec des feuilles exemples les déférents résultats (Etat, rapport, ...) que j'aimerais obtenir de ma feuille "Base".

Et j'espère que cette fois, je trouverais aide et compagnie

Merci d’avance.

 

[apt]

Re : Appliquer plusieurs filtres automatiques sur une base (2)

Bonjour Rachid, le fil

En essayant à nouveau le filtre élaboré avec en G1 "Date" et en G2 le 15/06/2012, j'ai tout le tableau des alarmes comme résultats au lieu de la date fixée dans la liste déroulante.

Sub Bouton1_Clic()
    Sheets("Base").Range("A7:F30").AdvancedFilter Action:=xlFilterCopy, _
                                                  CriteriaRange:=Sheets("Acceuil").Range("G1:J2"), CopyToRange:=Sheets("feuil1").Range("A7:F7"), Unique:=False
End Sub

Je crois qu'il n y a pas filtrage, parce que les cellules à filtrer contiennent en plus des dates des heures et minutes !?

Par exemple : 15/06/2012 15:06

Question :

Est-ce pratique d'appliquer la formule matricielle de la liste des dates (la formule s’étendra sur des centaines de lignes en bas), pour tous les jours de l'année, avec doublons ?

 

[apt]

Re : Appliquer plusieurs filtres automatiques sur une base (2)

Bonsoir,

Un essai en VBA pour remplir une liste de validation sans doublons en PJ.

Mais reste le problème des dates non uniformisées.

Sub ListeDate()
    Dim i%, v$, dPlg, oCel As Range, oPlg As Range
    Dim dic As Object, LastLg As Integer
    Set dic = CreateObject("Scripting.Dictionary")
    LastLg = Range("A" & Rows.Count).End(xlUp).Row
    MsgBox "LastLg = " & LastLg
    Set oPlg = Range("A1:A" & LastLg)   'plage de données
    dPlg = oPlg.Value
    '-- Tri
    With oPlg.Parent.Sort
        .SortFields.Clear
        .SortFields.Add Key:=oPlg.Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange oPlg
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .Apply
    End With
    On Error Resume Next
    
    '-- Récupérer les dates sans doublons
    For Each oCel In oPlg.Cells
        MsgBox "oCel = " & oCel & vbCrLf & _
        "Left oCel = " & Left(oCel, 10)
           dic(oCel.Value) = IIf(dic.Exists(Left(oCel.Value, 10)), dic(Left(oCel.Value, 10)) + 1, 1)
    Next oCel
    
    oPlg.Value = dPlg
    Set oPlg = Nothing
    Erase dPlg
    On Error GoTo 0
    Sheets("feuil1").Range("B2").Resize(dic.Count, 1) = Application.Transpose(dic.keys)
    
    '-- Plage nommée
    ActiveWorkbook.Names.Add Name:="MaListe", RefersTo:="=Feuil1!$B$2:$B$" & LastLg & ""
    '---------
    With [F2].Validation
        .Delete
        .Add Type:=xlValidateList, Formula1:="=MaListe"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
End Sub

 

[R@chid]

Re : Appliquer plusieurs filtres automatiques sur une base (2)

Bonsoir Apt,
je vais dire que je n'ai pas compris ce que tu veux faire avec ce code...
est ce que la formule que je t'ai donné pour extraire les dates sans doublons ne te convient pas???
Amicalement

 

[apt]

Re : Appliquer plusieurs filtres automatiques sur une base (2)

Bonsoir Rachid,

Non, la formule accomplie bien sa tache.

Mais comme j'ai de nombreuses lignes à saisir tout au long de l’année, j'ai pensé qu’un code vba fera l'affaire à la place des formules, en le mettant par exemple dans le Worksheet_Activate de la feuille "Accueil".