XL 2013 [VBA] Extraction de données basé sur 2 à 3 conditions

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
B

bastienb

XLDnaute Nouveau
Bonjour à tous,

J'ai une base de données (feuille Database) qui références des producteurs d'ingrédients, le type d'ingrédient, la référence commerciale et les caractéristiques techniques de chaque référence.

Je souhaiterais créer un outil pour faciliter la consultation des caractéristiques des références. L'accès aux données de la référence se fera après sélection de 3 critères : le producteur, le type et la référence.

Voici ce que j'ai déjà mis en place. Je joins un fichier anonymisé.

Sur la page Home, il y a 3 listes déroulantes en activex pour sélectionner les paramètres. À l'ouverture du fichier, une liste des producteurs sans doublons est générée sur la page construction, colonne B et ensuite chargé dans la liste déroulante correspondante. À la sélection d'un producteur via la liste déroulante, une liste des types de produits et eds références associées a ce producteur sont générée sur la feuille construction, en colonne D et F, et chargé dans la liste déroulante correspondante. À la sélection d'un type de produit , la liste référence est régénérée en tenant compte du double critère Producteur&Type de produit.

À chaque sélection dans les listes déroulantes, l'information est répercutée sur la page construction, en I6:K6, ce qui servira ensuite pour l'extraction des données.

Pour l'extraction, lorsqu'on modifie la sélection dans une liste (macros sur Home, List_conc_Change, List_ref_Change et List_type_Change), cela appelle la macro "extraire" du module 12. Cette macro va balayer la BDD de la feuille Database et récupérer la/les numéros de ligne(s) de cette BDD qui valide(nt) les conditions définies dans le range I6:K6 via les listes déroulantes. Les 4 cas de figure sont :

  • Seul I6 (producteur) est complété
  • I6 (producteur) et J6 (type de produit) sont complétés
  • I6 (producteur) et K6(références) sont complétés
  • I6, J6 et K6 sont complétés (dans cas il n'y aura qu'une ligne a extraire)
Voici le code correspondant

VB: 
Sub extraire()



Dim ligne_listes As Integer

Dim ligne_bd As Integer



If (Range("I6").Value = "" And Range("J6").Value = "" And Range("K6").Value = "") Then

Exit Sub

End If



'efface les donnée récupérées précédement

ligne_listes = 10

While (Sheets("construction").Cells(ligne_listes, 9).Value <> "")

Sheets("construction").Cells(ligne_listes, 9).Value = ""

Sheets("construction").Cells(ligne_listes, 10).Value = ""

Sheets("construction").Cells(ligne_listes, 11).Value = ""

Sheets("construction").Cells(ligne_listes, 12).Value = ""

Sheets("construction").Cells(ligne_listes, 13).Value = ""

Sheets("construction").Cells(ligne_listes, 14).Value = ""

Sheets("construction").Cells(ligne_listes, 15).Value = ""

Sheets("construction").Cells(ligne_listes, 16).Value = ""

Sheets("construction").Cells(ligne_listes, 17).Value = ""

Sheets("construction").Cells(ligne_listes, 18).Value = ""

Sheets("construction").Cells(ligne_listes, 19).Value = ""

Sheets("construction").Cells(ligne_listes, 20).Value = ""

Sheets("construction").Cells(ligne_listes, 21).Value = ""

Sheets("construction").Cells(ligne_listes, 22).Value = ""

Sheets("construction").Cells(ligne_listes, 23).Value = ""

Sheets("construction").Cells(ligne_listes, 24).Value = ""

Sheets("construction").Cells(ligne_listes, 25).Value = ""

ligne_listes = ligne_listes + 1

Wend



'parcours de la BDD pour identifier les numeros de lignes correspondant au cas ou il y a une correspondance

ligne_bd = 2

ligne_listes = 10

Sheets("Home").Select

While (Sheets("Database").Cells(ligne_bd, 1).Value <> "")

'extraction des lignes dans le cas ou il y a seulement I6 (producteur) de défini

    If (Range("I6").Value <> "" And Range("J6").Value = "" And Range("K6").Value = "") Then

        If (Sheets("Database").Cells(ligne_bd, 2).Value = Range("I6").Value) Then

        extraction ligne_listes, ligne_bd

        ligne_listes = ligne_listes + 1

        End If

'extraction des lignes dans le cas ou il y a I6 (producteur) et J6 (type de produit) de défini

    ElseIf (Range("I6").Value <> "" And Range("J6").Value <> "" And Range("K6").Value = "") Then

        If (Sheets("Database").Cells(ligne_bd, 2).Value = Range("J6").Value And Sheets("Database").Cells(ligne_bd, 3).Value = Range("J6").Value) Then

        extraction ligne_listes, ligne_bd

        ligne_listes = ligne_listes + 1

        End If

'extraction des lignes dans le cas ou il y a I6 (producteur) et K6 (Référence) de défini

    ElseIf (Range("J6").Value <> "" And Range("J6").Value = "" And Range("K6").Value <> "") Then

        If (Sheets("Database").Cells(ligne_bd, 2).Value = Range("J6").Value And Sheets("Database").Cells(ligne_bd, 4).Value = Range("K6").Value) Then

        extraction ligne_listes, ligne_bd

        ligne_listes = ligne_listes + 1

        End If

'extraction de la ligne dans le cas ou il y a I6 (producteur), J6 (type de produit) et K6 (référence) de défini

    ElseIf (Range("J6").Value <> "" And Range("J6").Value <> "" And Range("K6").Value <> "") Then

        If (Sheets("Database").Cells(ligne_bd, 2).Value = Range("J6").Value And Sheets("Database").Cells(ligne_bd, 3).Value = Range("J6").Value And Sheets("Database").Cells(ligne_bd, 4).Value = Range("K6").Value) Then

        extraction ligne_listes, ligne_bd

        ligne_listes = ligne_listes + 1

        End If

    End If

ligne_bd = ligne_bd + 1

Wend



End Sub

A chaque ligne qui correspond aux critères, cela fait appel a une macro "extraction" qui se charge de reporter les valeurs de la ligne dans la BDD sur la feuille Database dans la feuille construction, de la colonne I à Y, a partir de la ligne 10.

Voici le code qui je pense parraitrait très lourd et pas subtil du tout a certain O🙂

Code: 
Sub extraction(ligne_listes As Integer, ligne_bd As Integer)



Sheets("construction").Cells(ligne_listes, 9).Value = Sheets("Database").Cells(ligne_bd, 1).Value

Sheets("construction").Cells(ligne_listes, 10).Value = Sheets("Database").Cells(ligne_bd, 2).Value

Sheets("construction").Cells(ligne_listes, 11).Value = Sheets("Database").Cells(ligne_bd, 3).Value

Sheets("construction").Cells(ligne_listes, 12).Value = Sheets("Database").Cells(ligne_bd, 4).Value

Sheets("construction").Cells(ligne_listes, 13).Value = Sheets("Database").Cells(ligne_bd, 5).Value

Sheets("construction").Cells(ligne_listes, 14).Value = Sheets("Database").Cells(ligne_bd, 6).Value

Sheets("construction").Cells(ligne_listes, 15).Value = Sheets("Database").Cells(ligne_bd, 7).Value

Sheets("construction").Cells(ligne_listes, 16).Value = Sheets("Database").Cells(ligne_bd, 8).Value

Sheets("construction").Cells(ligne_listes, 17).Value = Sheets("Database").Cells(ligne_bd, 9).Value

Sheets("construction").Cells(ligne_listes, 18).Value = Sheets("Database").Cells(ligne_bd, 10).Value

Sheets("construction").Cells(ligne_listes, 19).Value = Sheets("Database").Cells(ligne_bd, 11).Value

Sheets("construction").Cells(ligne_listes, 20).Value = Sheets("Database").Cells(ligne_bd, 12).Value

Sheets("construction").Cells(ligne_listes, 21).Value = Sheets("Database").Cells(ligne_bd, 13).Value

Sheets("construction").Cells(ligne_listes, 22).Value = Sheets("Database").Cells(ligne_bd, 14).Value

Sheets("construction").Cells(ligne_listes, 23).Value = Sheets("Database").Cells(ligne_bd, 15).Value

Sheets("construction").Cells(ligne_listes, 24).Value = Sheets("Database").Cells(ligne_bd, 16).Value

Sheets("construction").Cells(ligne_listes, 25).Value = Sheets("Database").Cells(ligne_bd, 17).Value



End Sub

Pour être honnête, je ne vois pas ce qui cloche, mais en tout cas, je n'au rien qui s'affiche de la colonne I à Y, à partir de la ligne 10 sur la feuille construction.

Pourriez-vous m'aider à identifier mon erreur et à la solutionner svp?

Je vous remercie par avance

Bastien



ps1 : J'ai initialement choisit des listes déroulantes en activex mais de plus en plus je pense a les remplacer éventuellement par des listes déroulantes en validation de données basée sur les listes définir dans la feuille construction, car j'ai des problèmes de redimensionnement automatique de la liste a l'ouverture du fichier Excel et à l'usage de la liste. J'ai beau les redimensionner en mode création, quand je ressors du mode création ou si je ferme en enregistrant et que j'ouvre à nouveau le fichier, la liste est redimensionné. Si vous avez une solution, merci par avance, mais bon ce n'est pas le sujet principal de ce post ;-).

ps2 : juste pour mentionné, j'ai dû désactiver des bouts du code pour générer les listes dans la feuille construction, car y avait un bug dans la récupération des infos à cause du fait que les noms de mes références ou les types de produits ont des chaines de caractères en commun ce qui faisait que certain type de produit ou référence n'était pas récupéré. Je ferais un second post spécifique à ce problème par la suite, pour le moment, j'ai contourné le problème en désactivant certaines lignes de code et appliquant une suppression des doublons sur la liste générée. J'ai reproduit dans le fichié joint ce "phénomène" en donna tdes nom de produit tel que T1, T2 et T1/T2. Si vous activez le code desactivé, par exemple, si on sélectionne C2 pour producteur on n'aura que T1/T2 et T2 comme type de produit proposé.
 

Pièces jointes

Trier par date Trier par votes
Bonjour Bastien,
Outre le fait que le code peut être grandement simplifié, il y a, je pense, une erreur d'adressage page. Dans :
VB: 
Sheets("Home").Select
While (Sheets("Database").Cells(ligne_bd, 1).Value <> "")
'extraction des lignes dans le cas ou il y a seulement I6 (producteur) de défini
    If (Range("I6").Value <> "" And Range("J6").Value = "" And Range("K6").Value = "") Then
Le "If (Range("I6").Value <> " va regarder dans la feuille Home puisque c'est celle-ci qui est sélectionnée.
S'il faut chercher dans une autre feuille alors il faut préciser :
Code: 
Sheets("Home").Select
With Sheets("construction")    ' Selection de la feuille de recherche'
   While (Sheets("Database").Cells(ligne_bd, 1).Value <> "")
   'extraction des lignes dans le cas ou il y a seulement I6 (producteur) de défini
      If (.Range("I6").Value <> "" And .Range("J6").Value = "" And .Range("K6").Value = "") Then

        If (Sheets("Database").Cells(ligne_bd, 2).Value = .Range("I6").Value) Then
...
...
End with
( Ne pas oublier les points devant les Range )
 
Vote positif 0 Vote négatif
Hello,
merci en effet, c'était une part du probleme.
Comme suggerer j'ai également réaliser une simplification du code et finalement ça marche.
Voici le code final
VB: 
Sub extraire()

Dim ligne_listes As Integer
Dim ligne_bd As Integer

'If Application.CountBlank(Range("I6:K6")) = 3 Then Exit Sub

'efface les donnée récupérées précédement
ligne_listes = 10
While Sheets("construction").Cells(ligne_listes, 9).Value <> ""
    Sheets("construction").Range("I" & ligne_listes & ":Y" & ligne_listes).ClearContents
    ligne_listes = ligne_listes + 1
Wend

'parcours de la BDD (Database) pour identifier les numeros de lignes correspondant au cas ou il y a une correspondance
ligne_bd = 2
ligne_listes = 10
With Sheets("construction")
    While (Sheets("Database").Cells(ligne_bd, 1).Value <> "")
'extraction des lignes dans le cas ou il y a seulement I6 (producteur) de défini
        If Application.CountBlank(.Range("I6:K6")) = 2 Then
            'If .Range("I6").Value <> "" Then
                If Sheets("Database").Cells(ligne_bd, 2).Value = .Range("I6").Value Then
                    extraction ligne_listes, ligne_bd
                    ligne_listes = ligne_listes + 1
                End If
            'End If
'extraction des lignes dans le cas ou il y a I6 (producteur) et J6 (type de produit) de défini
        ElseIf Application.CountBlank(.Range("I6:K6")) = 1 Then
            'If .Range("K6").Value = "" Then
                If Sheets("Database").Cells(ligne_bd, 2).Value = .Range("I6").Value _
                And Sheets("Database").Cells(ligne_bd, 3).Value = .Range("J6").Value Then
                    extraction ligne_listes, ligne_bd
                    ligne_listes = ligne_listes + 1
                'End If
'extraction des lignes dans le cas ou il y a I6 (producteur) et K6 (Référence) de défini
            'ElseIf .Range("J6").Value = "" Then
                ElseIf Sheets("Database").Cells(ligne_bd, 2).Value = .Range("I6").Value _
                And Sheets("Database").Cells(ligne_bd, 4).Value = .Range("K6").Value Then
                    extraction ligne_listes, ligne_bd
                    ligne_listes = ligne_listes + 1
                End If
            'End If
'extraction de la ligne dans le cas ou il y a I6 (producteur), J6 (type de produit) et K6 (référence) de défini
        ElseIf Application.CountBlank(.Range("I6:K6")) = 0 Then
            If Sheets("Database").Cells(ligne_bd, 2).Value = .Range("I6").Value _
            And Sheets("Database").Cells(ligne_bd, 3).Value = .Range("J6").Value _
            And Sheets("Database").Cells(ligne_bd, 4).Value = .Range("K6").Value Then
                extraction ligne_listes, ligne_bd
                ligne_listes = ligne_listes + 1
            End If
        End If
    ligne_bd = ligne_bd + 1
    Wend
End With

End Sub

Code: 
Sub extraction(ligne_listes As Integer, ligne_bd As Integer)

Dim wsCons As Worksheet, wsData As Worksheet

Set wsCons = Sheets("construction")
Set wsData = Sheets("Database")

wsCons.Range("I" & ligne_listes & ":Y" & ligne_listes).Value = wsData.Range("A" & ligne_bd & ":Q" & ligne_bd).Value

Set wsCons = Nothing
Set wsData = Nothing

End Sub
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

S
  • Résolu(e)
Microsoft 365 Mailing mise en forme HTML : revenir à la ligne automatique si trop de texte saisie
2
Réponses
17
Affichages
204
spike29
S
K
  • Résolu(e)
XL 2016 Affichage TextBox
Réponses
6
Affichages
99
KRUG WOO
K
D
  • Question Question
XL 2021 Filtre Multi Critères Listview VBA
2
Réponses
21
Affichages
2 K
Dranreb
Dranreb
C
  • Résolu(e)
XL 2021 Remplir données devis en vba avec descriptions/quantités/PUs alignés
2
Réponses
18
Affichages
1 K
Phil69970
Phil69970
S
  • Résolu(e)
Microsoft 365 Envoi de la signature de l'utilisateur macro envoi de mail
Réponses
3
Affichages
269
spike29
S
G
  • Résolu(e)
XL 2016 Pb de tri et sous totaux
2
Réponses
27
Affichages
334
Gestionnaire_rh
G
S
  • Résolu(e)
Microsoft 365 VBA Match: comment éviter l'erreur?
2
Réponses
29
Affichages
551
Dranreb
Dranreb
L
  • Question Question
VBA : erreur sur boucle
Réponses
2
Affichages
302
Latias
L
klin89
  • Question Question
Microsoft 365 Méthode Evaluate pour se dispenser d'une boucle imbriquée
Réponses
14
Affichages
396
patricktoulon
patricktoulon
jeff1494
  • Question Question
XL 2021 Comment supprimer des noms du gestionnaire de noms dans un classeur
Réponses
7
Affichages
383
jeff1494
jeff1494
T
  • Résolu(e)
XL 2019 Filtrer certains champs au démarrage avec vba
2
Réponses
15
Affichages
176
telemarrk
T
G
  • Résolu(e)
XL 2021 VBA dates au mauvais format
Réponses
5
Affichages
318
vgendron
vgendron
lynyrd
  • Question Question
XL 2019 code pour tous les disques
Réponses
3
Affichages
599
AtTheOne
AtTheOne
N
  • Résolu(e)
Microsoft 365 Calcul de plages horaires
2 3 4
Réponses
49
Affichages
1 K
NONO14
N
C
  • Question Question
XL 2021 Problème de remplissage d'une colonne conditionné à d'autres valeurs
Réponses
2
Affichages
432
CathyLD
C
M
  • Question Question
XL 2010 Aide à la suppression d'un produit en double dans un magasin spécifique avec conditions
Réponses
9
Affichages
796
Mody200
M
M
  • Question Question
XL 2013 MACRO VBA pour imprimer tous les bulletins d'un établissement scolaire
Réponses
4
Affichages
305
MBEPID
M
Nicolas JACQUIN
  • Question Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
1 K
Nicolas JACQUIN
Nicolas JACQUIN
M
  • Question Question
Microsoft 365 Erreur sur mon Code VBA
Réponses
2
Affichages
407
Gégé-45550
Gégé-45550
D
  • Question Question
XL 2010 Identification d'une cellule cliquée
Réponses
6
Affichages
651
dadu35
D
Retour