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

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

  • tableau-comparatif-test.xlsm
    135.7 KB · Affichages: 31

sylvanu

XLDnaute Barbatruc
Supporter XLD
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 )
 

bastienb

XLDnaute Nouveau
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
 

Discussions similaires

Réponses
1
Affichages
119
Réponses
0
Affichages
83

Statistiques des forums

Discussions
311 723
Messages
2 081 932
Membres
101 844
dernier inscrit
pktla