XL 2019 Recherche basée sur critères

[duplaly]

Bonjour

J'essaye de réaliser une recherche basée sur des critères.

Extraire en liste sans doublon les # de semaines utilisées dans la feuille (Commande), colonne (E) pour les critères mentionnés en cellules (B2, C2, D2) dans la feuille Résultat.

Si je change d'années, les semaines doivent changer aussi en fonction des critères.

Dans mon code actuel proposé par un collègue, cela fonctionne sur 2 critères dans la feuille résultat en «B2 et C2». J'aimerais rajouter le critère en D2 dans la recherche.

J'ai mis mon fichier pour être plus clair dans ce que je dis.

Merci pour votre aide et temps précieux!

 

[Lolote83]

Re bonjour à tous,
Vu que tu souhaites afficher uniquement la colonne WEEK, voici mon fichier corrigé
Même en mettant 2x la même année, cela fonctionne
@+ Lolote83

 

[Lolote83]

Re bonjour CHTI160,
Chez moi, pour 2021 et JOUR, c'est le n°2 qui sort (ligne 132 du fichier d'origine)
@+ Lolote83

 

[chris]

Idem

 

[Lolote83]

Re bonjour,
Chris, le "Idem" s'adresse à moi ou à CHTI160 ?
Merci
@+ Lolote83

 

[ChTi160]

Re
le problème vient que dans la procédure de duplaly
il a if d.count > 1 j'ai mis If d.count >= 1 et c'est Bon !

  If d.Count >= 1 Then
        Worksheets("Résultat").Range("A2").Resize(d.Count) = Application.Transpose(d.Items)
    Else
        Worksheets("Résultat").Range("A2").Value = d.Item(1)
    End If

je regarde car il y a un problème avec le Tri ensuite si 1 Ligne
jean marie

 

[chris]

RE
@Lolote83
A toi,
mais la réponse de Jean Marie le confirme

 

[Lolote83]

RE
@Lolote83
A toi,
mais la réponse de Jean Marie le confirme

Merci Chris, je viens de voir.
Bonne journée et te tiens au courant pour ce problème de version
@+ Lolote83

 

[ChTi160]

Re
la procédure revue !

Sub Recherche()
Dim a(), d As New Dictionary, i As Long, an1 As Long, an2 As Long, Periode$
    Application.ScreenUpdating = False
    a = Worksheets("Commande").UsedRange.Value
   With Worksheets("Résultat")
        .Range("A2:A100").ClearContents
     an1 = .Range("B2").Value: an2 = .Range("C2").Value
        Periode$ = .Range("D2").Value
    For i = 2 To UBound(a)
        If Year(a(i, 1)) = an1 And a(i, 11) Like Periode Or Year(a(i, 1)) = an2 And a(i, 11) Like Periode Then   'needed date
            d(a(i, 5)) = a(i, 5)
        End If
    Next
    If d.Count >= 1 Then
        .Range("A2").Resize(d.Count) = Application.Transpose(d.Items)
    Else
        .Range("A2").Value = d.Item(1)
    End If
    .Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row).Sort key1:=.Range("A2"), order1:=xlAscending, Header:=xlYes
    End With
    Application.ScreenUpdating = True
End Sub

jean marie

 

[chris]

RE

Merci Chris, je viens de voir.
Bonne journée et te tiens au courant pour ce problème de version
@+ Lolote83

C'est juste pour nous car outre le multipost sur au moins 3 forums, le demandeur nous ignore totalement...

Seul le code de Jean Marie l'intéressant, il continue dans l'impolitesse...

 

[ChTi160]

Merci chris et Lolote83
jean marie

 

[Lolote83]

Re bonsoir.
Afin de terminer cette conversation sur de bonne augure, la version de Chris fonctionne bien à la maison avec Excel 365 Apps for Entreprise.
Bonne soirée à toi Chris et à toi ChTi160.
@+ Lolote83

 

[chris]

Bonsoir

Cool !
Sinon tu as vérifié quelle est la révision de 2016 au bureau ?

Ce qui déc...ne c'est le dédoublonnage : je n'ai jamais vu ce PB avant.

On peut contourner cette anomalie mais je ne pige pas ce qui la provoque sur l'add on...

Bonne nuit les petits

 

[duplaly]

Merci tout le monde pour les réponses proposées.
Le code révisé fonctionne à merveille.

 

[Pierre Fauconnier]

Salut.

Comme déjà répondu sur un autre forum:

• un tableau structuré, évidemment;
• une plage nommée critères (C1:C2 sur l'illustration) avec une cellule formulée par rapport à la première ligne du tableau structuré;
• Une plage Résultat (La cellule A1 de l'illustration)
• Un filtre avancé en VBA...

Une seule ligne de code:

Sub Recherche1()
  Range("tableau1[#all]").AdvancedFilter xlFilterCopy, Range("critères"), Range("Résultat"), True
End Sub

[EDIT]Code et Image d'écran édités suite aux judicieuses remarques de Jean-Marie

Il y a plein d'avantages à travailler avec les tableaux structurés les plages nommées, notamment le fait que les adresses des cellules et plages ne sont pas en dur dans le code (hard coding) de sorte que si on déplace les tableaux et cellules, le code continue à fonctionner sans soucis.

L'avantage d'utiliser le filtre avancé avec un critère formulé, c'est que l'on ne code pas le critère, de sorte que s'il faut le modifier, on ne touche qu'à la formule, et le code, là aussi, continue à fonctionner...

Règle de base: Lorsque l'on code en VBA pour Excel, on pense Excel avant de penser VBA...

 

[ChTi160]

Bonjour Pierre
Bienvenue !
Quelle chance de vous croiser Ici !
Merci
Jean marie