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]

Bonjour DUPLALY,
Voici ton fichier en retour avec filtre élaboré.
Dans l'onglet Result, les critères sont en B3:C4
Clic sur le bouton TEST, et la liste correspondant à tes critères s'affichera.
@+ Lolote83

 

[ChTi160]

Re
Bonjour Lolote83

peut être avec cette adaptation de ta procédure !

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
    Worksheets("Résultat").Range("A2:A100").ClearContents
             an1 = Worksheets("Résultat").Range("B2").Value: an2 = Worksheets("Résultat").Range("C2").Value
        Periode$ = Worksheets("Résultat").Range("D2").Value
    For i = 2 To UBound(a)
        If Year(a(i, 1)) = an1 And a(i, 11) = Periode Or Year(a(i, 1)) = an2 And a(i, 11) = Periode Then   'needed date
            d(a(i, 5)) = a(i, 5)
        End If
    Next
    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
    Worksheets("Résultat").Range("A2:A" & Worksheets("Résultat").Cells(Worksheets("Résultat").Rows.Count, "A").End(xlUp).Row).Sort key1:=Worksheets("Résultat").Range("A2"), order1:=xlAscending
    Application.ScreenUpdating = True
End Sub

ajout du troisième critère .
Bonne journée
jean marie
Edit : j'ai modifié la procédure 9:20

 

[chris]

Bonjour à tous

Une solution sans VBA par PowerQuery intégré à Excel

Si on choisit plus d'une année, le résultat affiche les années et semaines, sinon seulement les semaines

Actualiser par Données, Actualiser tout ou par clic droit dans le tableau de résultat

 

[chris]

Encore un multipost

 

[Lolote83]

Re bonjour à tous.
Purée, encore du PowerQuery et je n'y ai pas pensé.
Cependant, suite à mon extraction, je trouve en plus de Chris du 20 et du 48 que l'on ne retrouve pas dans son fichier.

A voir.
@+ Lolote83

 

[ChTi160]

Re
j'ai le même résultat que toi Lolote83 (sans PowerQuery) Lol
jean marie

 

[chris]

Heu

j'ai bien 20 et 48 aussi...

C ki kabu ?

 

[ChTi160]

Re
ben oui alors Lol
jean marie

 

[Lolote83]

Re bonjour,
Chris,
- A l'ouverture du fichier joint au post#4, voici la liste triée (Dernière ligne = 14)

- Après actualisation (Dernière ligne = 12)

Les valeurs 20 et 48 ont disparues
Que ce passe-t-il ?

Et avec la petite animation

@+ Lolote83

 

[chris]

RE

ta version 2016 est à jour ?

J'ai effectivement le problème sur l'Add on mais pas sur 365
Je vais vérifier 2019

 

[chris]

RE

2019 révision 2108 : pas d'anomalie
Donc mise à jour de 2016 à faire

 

[Lolote83]

Re bonjour Chris,
Merci pour ce complément d'information.
Je regarderais ce soir à la maison en fonction de ma version XL.
Les copie d'écran ci-dessus ont été faite au bureau (Excel 2016 effectivement)
Je te tiens au courant
@+ Lolote83

 

[duplaly]

Re
Bonjour Lolote83

peut être avec cette adaptation de ta procédure !

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
    Worksheets("Résultat").Range("A2:A100").ClearContents
             an1 = Worksheets("Résultat").Range("B2").Value: an2 = Worksheets("Résultat").Range("C2").Value
        Periode$ = Worksheets("Résultat").Range("D2").Value
    For i = 2 To UBound(a)
        If Year(a(i, 1)) = an1 And a(i, 11) = Periode Or Year(a(i, 1)) = an2 And a(i, 11) = Periode Then   'needed date
            d(a(i, 5)) = a(i, 5)
        End If
    Next
    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
    Worksheets("Résultat").Range("A2:A" & Worksheets("Résultat").Cells(Worksheets("Résultat").Rows.Count, "A").End(xlUp).Row).Sort key1:=Worksheets("Résultat").Range("A2"), order1:=xlAscending
    Application.ScreenUpdating = True
End Sub

ajout du troisième critère .
Bonne journée
jean marie
Edit : j'ai modifié la procédure 9:20

Re
Bonjour Lolote83

peut être avec cette adaptation de ta procédure !

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
    Worksheets("Résultat").Range("A2:A100").ClearContents
             an1 = Worksheets("Résultat").Range("B2").Value: an2 = Worksheets("Résultat").Range("C2").Value
        Periode$ = Worksheets("Résultat").Range("D2").Value
    For i = 2 To UBound(a)
        If Year(a(i, 1)) = an1 And a(i, 11) = Periode Or Year(a(i, 1)) = an2 And a(i, 11) = Periode Then   'needed date
            d(a(i, 5)) = a(i, 5)
        End If
    Next
    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
    Worksheets("Résultat").Range("A2:A" & Worksheets("Résultat").Cells(Worksheets("Résultat").Rows.Count, "A").End(xlUp).Row).Sort key1:=Worksheets("Résultat").Range("A2"), order1:=xlAscending
    Application.ScreenUpdating = True
End Sub

ajout du troisième critère .
Bonne journée
jean marie
Edit : j'ai modifié la procédure 9:20

Bonjour
J'aime bien le code proposé qui fonctionne. Il y a juste une petite correction à apporter selon mon test.
si je choisi la même année dans les critères 1 et 2, je n'ai aucun résultat.

Merci pour ton temps

 

[ChTi160]

Re
peut être parce qu'il n'y a pas de données a retourner pour ce cas de figure Lol
chez moi pour 2021 et Jour y'a rien !

jean marie