XL 2019 Recherche basée sur critères

duplaly · 7 Octobre 2021

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 · 7 Octobre 2021

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 · 7 Octobre 2021

Re
Bonjour Lolote83

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

VB:

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 · 7 Octobre 2021

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 · 7 Octobre 2021

Encore un multipost

Lolote83 · 7 Octobre 2021

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 · 7 Octobre 2021

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

chris · 7 Octobre 2021

Heu

j'ai bien 20 et 48 aussi...

C ki kabu ?

ChTi160 · 7 Octobre 2021

Re
ben oui alors Lol
jean marie

Lolote83 · 7 Octobre 2021

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 · 7 Octobre 2021

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 · 7 Octobre 2021

RE

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

Lolote83 · 7 Octobre 2021

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 · 7 Octobre 2021

ChTi160 à dit:

Re
Bonjour Lolote83

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

VB:

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

ChTi160 à dit:

Re
Bonjour Lolote83

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

VB:

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 · 7 Octobre 2021

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

XL 2019 Recherche basée sur critères

duplaly

XLDnaute Occasionnel

Pièces jointes

Lolote83

XLDnaute Barbatruc

Pièces jointes

ChTi160

XLDnaute Barbatruc

chris

XLDnaute Barbatruc

Pièces jointes

chris

XLDnaute Barbatruc

Lolote83

XLDnaute Barbatruc

ChTi160

XLDnaute Barbatruc

Pièces jointes

chris

XLDnaute Barbatruc

ChTi160

XLDnaute Barbatruc

Lolote83

XLDnaute Barbatruc

Pièces jointes

chris

XLDnaute Barbatruc

chris

XLDnaute Barbatruc

Lolote83

XLDnaute Barbatruc

duplaly

XLDnaute Occasionnel

ChTi160

XLDnaute Barbatruc

Discussions similaires