Liste déroulante dans la fonction si avec plusieurs conditions

lys · 28 Janvier 2011

Bonjour,
Je ne suis pas une experte d'Excel mais bon on va dire que je me débrouille sauf que là je fais la brasse coulée depuis une semaine

.
J'ai créé un formulaire (ci-joint) avec une base de donées. Jusque là tout va bien. Je voudrais ensuite automatiser ce formulaire au maximum grace aux informations de la bd c'est à dire : quand lorsque dans la colonne A je sélectionne "HOTEL", dans la colonne B s'affiche une liste déroulante avec un choix d'hotels et ainsi de suite jusqu'au prix unitaire....
J'ai essayé plusieurs formules mais à part un sérieux mal de tête rien ne viens

Peut-être est-ce trop compliqué me dit-on ...??
Quelqu'un aurait-il une solution ?
D'avance MERCI

KenDev · 28 Janvier 2011

Re : Liste déroulante dans la fonction si avec plusieurs conditions

Bonjour Lys,

Je te propose les codes suivants pour ce que tu veux. Le code est peu documenté mais si il y a des choses que tu comprends pas (ou qui marchent pas!) hésite pas.

Important : La feuille Bases de données doit toujours être triée sur les 4 premières colonnes, c'est à dire comme elle est actuellement (ou quel que soit l'ordre de tri) du moment qu'est respecté le principe trié sur col A puis B puis C puis D. Et bien sûr que cette feuille soit réservée uniquement à la base.

1er code, à coller dans le module ThisWorkbook :

VB:

Option Explicit

Private Sub Workbook_Open()

    Dim oWsBd As Worksheet
    Dim oWSFm As Worksheet
    Dim i As Long
    Dim vCol As Byte
    Dim vStr As String

    Set oWsBd = Worksheets("Base de données")
    Set oWSFm = Worksheets("Formulaire")
    vCol = 1
    vStr = ""
    For i = 2 To oWsBd.Cells(oWsBd.Cells(Rows.Count, vCol).End(xlUp).Row, vCol).Row
        Select Case vStr
            Case ""
                If oWsBd.Cells(i, vCol) <> oWsBd.Cells(i - 1, vCol) Then vStr = vStr & oWsBd.Cells(i, vCol)
            Case Else
                If oWsBd.Cells(i, vCol) <> oWsBd.Cells(i - 1, vCol) Then vStr = vStr & "," & oWsBd.Cells(i, vCol)
        End Select
    Next i
    With Range(oWSFm.Cells(13, 1), oWSFm.Cells(36, 1)).Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:=vStr
        .IgnoreBlank = True
        .InCellDropdown = True
        .ErrorMessage = "choisir un item de la liste déroulante"
        .ShowError = True
    End With
    
    Set oWsBd = Nothing
    Set oWSFm = Nothing
    
End Sub

Ce code sert, à l'ouverture du classeur, à ajouter la lliste de validation catégorie en colonne 1 du formulaire.

2ème code, à coller dans un module standard :

VB:

Option Explicit

Dim oWsBd As Worksheet 'feuille base de données

Public Function List_Cat() As String 'Liste catégorie
Dim i As Long
Dim vCol As Byte

    Set oWsBd = Worksheets("Base de données")
    vCol = 1 'colonne
    List_Cat = "" 'valeur de la liste
    
    'pour chaque ligne de la base de données
    For i = 2 To oWsBd.Cells(oWsBd.Cells(Rows.Count, vCol).End(xlUp).Row, vCol).Row
        'si la cellule rencontrée est différente de la précédente noter le nouvel item
        Select Case List_Cat
            Case "" '1ere occurence
                If oWsBd.Cells(i, vCol) <> oWsBd.Cells(i - 1, vCol) Then List_Cat = List_Cat & oWsBd.Cells(i, vCol)
            Case Else 'suivantes
                If oWsBd.Cells(i, vCol) <> oWsBd.Cells(i - 1, vCol) Then List_Cat = List_Cat & "," & oWsBd.Cells(i, vCol)
        End Select
    Next i
    
    Set oWsBd = Nothing
    
End Function

Public Function List_Nom(vCat As String) As String 'vCat est le paramètre d'entrée (nom de la catégorie)
Dim i As Long
Dim vCol As Byte

    Set oWsBd = Worksheets("Base de données")
    vCol = 2
    List_Nom = ""
    
    For i = 2 To oWsBd.Cells(oWsBd.Cells(Rows.Count, vCol).End(xlUp).Row, vCol).Row
        If oWsBd.Cells(i, vCol - 1) = vCat Then 'si la catégorie est bien celle qu'on a mise en paramètre d'entrée
            'si la cellule rencontrée est différente de la précédente noter le nouvel item
            Select Case List_Nom
                Case ""
                    If oWsBd.Cells(i, vCol) <> oWsBd.Cells(i - 1, vCol) Then List_Nom = List_Nom & oWsBd.Cells(i, vCol)
                Case Else
                    If oWsBd.Cells(i, vCol) <> oWsBd.Cells(i - 1, vCol) Then List_Nom = List_Nom & "," & oWsBd.Cells(i, vCol)
            End Select
        End If
    Next i
    
    Set oWsBd = Nothing
    
End Function

Public Function List_Pre(vCat As String, vNom As String) As String
Dim i As Long
Dim vCol As Byte

    Set oWsBd = Worksheets("Base de données")
    vCol = 3
    List_Pre = ""
    
    For i = 2 To oWsBd.Cells(oWsBd.Cells(Rows.Count, vCol).End(xlUp).Row, vCol).Row
        If oWsBd.Cells(i, vCol - 2) = vCat Then
            If oWsBd.Cells(i, vCol - 1) = vNom Then
                Select Case List_Pre
                    Case ""
                        If oWsBd.Cells(i, vCol) <> oWsBd.Cells(i - 1, vCol) Then List_Pre = List_Pre & oWsBd.Cells(i, vCol)
                    Case Else
                        If oWsBd.Cells(i, vCol) <> oWsBd.Cells(i - 1, vCol) Then List_Pre = List_Pre & "," & oWsBd.Cells(i, vCol)
                End Select
            End If
        End If
    Next i
    
    Set oWsBd = Nothing
    
End Function

Public Function List_Des(vCat As String, vNom As String, vPre As String) As String
Dim i As Long
Dim vCol As Byte

    Set oWsBd = Worksheets("Base de données")
    vCol = 4
    List_Des = ""
    
    For i = 2 To oWsBd.Cells(oWsBd.Cells(Rows.Count, vCol).End(xlUp).Row, vCol).Row
        If oWsBd.Cells(i, vCol - 3) = vCat Then
            If oWsBd.Cells(i, vCol - 2) = vNom Then
                If oWsBd.Cells(i, vCol - 1) = vPre Then
                    Select Case List_Des
                        Case ""
                            If oWsBd.Cells(i, vCol) <> oWsBd.Cells(i - 1, vCol) Then List_Des = List_Des & oWsBd.Cells(i, vCol)
                        Case Else
                            If oWsBd.Cells(i, vCol) <> oWsBd.Cells(i - 1, vCol) Then List_Des = List_Des & "," & oWsBd.Cells(i, vCol)
                    End Select
                End If
            End If
        End If
    Next i
    
    Set oWsBd = Nothing
    
End Function

Public Function List_Prx(vCat As String, vNom As String, vPre As String, vDes As String) As Long
Dim i As Long
Dim vCol As Byte

    Set oWsBd = Worksheets("Base de données")
    vCol = 5
    List_Prx = 0
    
    For i = 2 To oWsBd.Cells(oWsBd.Cells(Rows.Count, vCol).End(xlUp).Row, vCol).Row
        If oWsBd.Cells(i, vCol - 4) = vCat Then
            If oWsBd.Cells(i, vCol - 3) = vNom Then
                If oWsBd.Cells(i, vCol - 2) = vPre Then
                    If oWsBd.Cells(i, vCol - 1) = vDes Then
                        List_Prx = oWsBd.Cells(i, vCol)
                    End If
                End If
            End If
        End If
    Next i
    
    Set oWsBd = Nothing
    
End Function

Une fonction par catégorie de liste. Ces fonctions seront appelées par le code suivant. Mis à part la première elles ont des paramètres en entrées (entre parenthèses des lignes Private Function) qui leur permettent de savoir quels mots aller chercher dans la feuille Bases de données.

3ème code, à coller dans le module de la feuille formulaire

VB:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim i As Byte

    If Target.Count > 1 Then Exit Sub 'si plusieurs cellules changent en même temps
    
    If Target.Row < 13 Then Exit Sub 'ne concerne que les lignes du tableau
    
    'Colonne catégorie
    If Target.Column = 1 Then
        'efface les colonnes 2, 3, 5, 6
        For i = 1 To 5
            If i <> 3 Then Target.Offset(0, i).Value = ""
        Next i
        'listes de validations
            'si Divers effacer les listes de la ligne
        If Target.Value = "DIVERS" Then
            For i = 1 To 6
                If i <> 3 Then
                    With Target.Offset(0, i).Validation
                        .Delete
                    End With
                End If
            Next i
        Else
            'si vide effacer la liste fournisseur
            If Target.Value = "" Then
                'sinon modifier la liste fournisseur
                With Target.Offset(0, 1).Validation
                    .Delete
                End With
            Else
                With Target.Offset(0, 1).Validation
                    .Delete
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                        xlBetween, Formula1:=List_Nom(Cells(Target.Row, 1).Value)
                    .IgnoreBlank = True
                    .InCellDropdown = True
                    .ErrorMessage = "choisir un item de la liste déroulante"
                    .ShowError = True
                End With
            End If
        End If
        Exit Sub
    End If
    
    'Colonne fournisseurs
    If Target.Column = 2 Then
        'efface les colonnes 3, 5 ,6
        For i = 1 To 4
            If i <> 2 Then Target.Offset(0, i).Value = ""
        Next i
        'listes de validations
            'si vide effacer la liste prestation
        If Target.Value = "" Then
            With Target.Offset(0, 1).Validation
                .Delete
            End With
        Else    'sinon la modifier
            With Target.Offset(0, 1).Validation
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                    xlBetween, Formula1:=List_Pre(Cells(Target.Row, 1).Value, Cells(Target.Row, 2).Value)
                .IgnoreBlank = True
                .InCellDropdown = True
                .ErrorMessage = "choisir un item de la liste déroulante"
                .ShowInput = False
                .ShowError = True
            End With
        End If
    End If
    
    'Colonne Prestations
    If Target.Column = 3 Then
        'efface les colonnes 5,6
        For i = 2 To 3
            Target.Offset(0, i).Value = ""
        Next i
        'listes de validations
            'si vide effacer la liste désignation
        If Target.Value = "" Then
            With Target.Offset(0, 2).Validation
                .Delete
            End With
            'sinon la modifier
        Else
            With Target.Offset(0, 2).Validation
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                    xlBetween, Formula1:=List_Des(Cells(Target.Row, 1).Value, Cells(Target.Row, 2).Value, Cells(Target.Row, 3).Value)
                .IgnoreBlank = True
                .InCellDropdown = True
                .ErrorMessage = "choisir un item de la liste déroulante"
                .ShowError = True
            End With
        End If
    End If
    
    'colonne nombre
        'recalcul montant total
    If Target.Column = 4 Then
        Cells(Target.Row, 7) = Cells(Target.Row, 4) * Cells(Target.Row, 6)
    End If
    
    'Colonne Désignation
    If Target.Column = 5 Then
        'efface colonnes 6
        Target.Offset(0, 1).Value = ""
        'entrée du prix
        Cells(Target.Row, 6) = List_Prx(Cells(Target.Row, 1).Value, Cells(Target.Row, 2).Value, Cells(Target.Row, 3).Value, Cells(Target.Row, 5).Value)
    End If
    
    'Colonne Prix
        'recalcul montant total
    If Target.Column = 6 Then
        Cells(Target.Row, 7) = Cells(Target.Row, 4) * Cells(Target.Row, 6)
    End If
    
End Sub

C'est la qu'est déterminé quelles sont les cellules modifiées et ce qu'il convient de faire. (effacer les cellules à droite de la cellule modifiée, apeller les fonctions changeant les listes de validation...).

La feuille choix devient inutile.

Cordialement

KD

Edit : j'ajoute le fichier

david84 · 28 Janvier 2011

Re : Liste déroulante dans la fonction si avec plusieurs conditions

Bonsoir,
cf

Formation Excel VBA JB

=> liste cascade
A+

lys · 29 Janvier 2011

Re : Liste déroulante dans la fonction si avec plusieurs conditions

KenDev je te vénère

tu es mon sauveur !!!
Mille fois merci, c'est clair que toute seule je n'y serai pas arrivée. Tout fonctionne Nickel ! Encore merci, si je rencontre d'autres soucis sur excel je saurai à qui m'adresser loool

A+++
Lys

KenDev · 29 Janvier 2011

Re : Liste déroulante dans la fonction si avec plusieurs conditions

Bonjour Lys, bonjour David,

@ David : Merci pour le lien !! Page marquée (ça m'évitera d'avoir à réinventer la roue sur quelques trucs...

)

BOISGONTIER · 29 Janvier 2011

Re : Liste déroulante dans la fonction si avec plusieurs conditions

Bonjour,

Voir PJ

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Set f = Sheets("BD")
  Application.ScreenUpdating = False
  If Not Intersect([A13:A40], Target) Is Nothing And Target.Count = 1 Then
    f.[n2] = Empty
    f.[A1:D1000].AdvancedFilter Action:=xlFilterCopy, _
      CriteriaRange:=f.[N1:N2], CopyToRange:=f.[G1], Unique:=True
  End If
  If Not Intersect([B13:B40], Target) Is Nothing And Target.Count = 1 Then
     f.[n2] = Target.Offset(0, -1)
     f.[o2] = Empty
     f.[A1:D1000].AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=f.[N1:O2], CopyToRange:=f.[H1], Unique:=True
  End If
  If Not Intersect([C13:C40], Target) Is Nothing And Target.Count = 1 Then
    f.[n2] = Target.Offset(0, -2)
    f.[o2] = Target.Offset(0, -1)
    f.[p2] = Empty
    f.[A1:D1000].AdvancedFilter Action:=xlFilterCopy, _
      CriteriaRange:=f.[N1:P2], CopyToRange:=f.[I1], Unique:=True
   End If
   If Not Intersect([e13:e40], Target) Is Nothing And Target.Count = 1 Then
    f.[n2] = Target.Offset(0, -4)
    f.[o2] = Target.Offset(0, -3)
    f.[p2] = Target.Offset(0, -2)
    f.[q2] = Empty
    f.[A1:D1000].AdvancedFilter Action:=xlFilterCopy, _
      CriteriaRange:=f.[N1:Q2], CopyToRange:=f.[J1], Unique:=True
   End If
End Sub

JB

KenDev · 29 Janvier 2011

Re : Liste déroulante dans la fonction si avec plusieurs conditions

Bonjour Lys, bonjour le fil,

@Lys : Vénère plutôt le monsieur du post ci-dessus...

@BOISGONTIER : speechless...

lys · 31 Janvier 2011

Re : Liste déroulante dans la fonction si avec plusieurs conditions

Bonjour à tous,
@ BOISGONTIER : merci beaucoup, je ne pensais pas qu'autant de personnes s'interresseraient à mon cas Lol ;-)
@ KenDev : je ne comprends pas ? tu penses que le fichier de BOISGONTIER est meilleur ?
j'ai déjà commencé à utiliser le tiens et je le trouve plus pratique... Je m'explique : dans ton fichier, quand dans la 1ère colonne tu changes la catégorie tout le reste s'efface tandis que dans le fichier de BOISGONTIER, si tu changes la catégorie les autres colonnes ne se mettent pas à jour...
Tu peux me dire pourquoi tu penses que l'autre est mieux stp ??

BOISGONTIER · 31 Janvier 2011

Re : Liste déroulante dans la fonction si avec plusieurs conditions

Bonjour,

Voir PJ

JB

KenDev · 31 Janvier 2011

Re : Liste déroulante dans la fonction si avec plusieurs conditions

Bonjour Lys, bonjour BOISGONTIER, le fil,

Ce qui m'a le plus épaté dans son fichier c'est la brieveté de son code et donc son élégance et son poids, y'a pas photo! En cas de modification de ton formulaire le sien sera bien plus facile à adapter. Le sien est plus universel, le mien spécifique.
Ceci dit c'est vrai que je n'avais pas remarqué ce que tu met en avant mais ces fontionalités supplémentaires n'avaient pas été spécifiquement demandées.

Dans sa version 3 quand on modifie une catégorie, la colonne 2 prends d'office la valeur du 1er fournisseur trouvé. Je trouve ce choix très pertinent pour les catégories n'ayant qu'un fournisseur mais plus discutable pour celles en ayant plusieurs (pourquoi mettre ainsi "Le Méridien" en avant par rapport au autres ? Sa version 2 fait comme le mien avec les avantages précités.

Les spécifités que je conserve, c'est la colonne prix calculée par la macro plutôt que par formule, cela évite juste les #N/A dans les colonnes montant et prix tant que tous les champs ne sont pas rempli, mais c'est là une histoire de goût et couleurs. Par contre, la valeur DIVERS est autorisée chez moi en colonne 1 comme spécifié dans la base mais j'y ai remarqué un bug : on peut saisir après ce que l'on veut dans les autres colonnes mais avec un bug d'éxécution.

Le correctif :
Dans la sub

VB:

Private Sub Worksheet_Change(ByVal Target As Range)

modifier les deux lignes suivantes :

VB:

If Target.Column = 2 Then
If Target.Column = 3 Then

par

VB:

If Target.Column = 2 And Cells(Target.Row, 1) <> "DIVERS" Then
If Target.Column = 3 And Cells(Target.Row, 1) <> "DIVERS" Then

Fichier joint.

Cordialement

KD

bcharef · 1 Février 2011

Re : Liste déroulante dans la fonction si avec plusieurs conditions

Bonjour Lys et bienvenue sur XLD,
Bonjour KenDev, david84 & JB,
Bonjour à toutes et à tous.

Un essai ci-joint portant deux classeurs, le premier porte un petit morceau de code VBA, qui permet d'afficher la position de la cellule active, et le deuxième sans code VBA, avec des formules matricielles, à valider par ctrl, maj et entrée.
.

Il est à noter que, je suis un ignare en matiére de VBA.

Cordialement.

BCharef

Effectuez une recherche sur Excel Downloads...

Liste déroulante dans la fonction si avec plusieurs conditions

lys

XLDnaute Nouveau

KenDev

XLDnaute Impliqué

Pièces jointes

david84

XLDnaute Barbatruc

lys

XLDnaute Nouveau

KenDev

XLDnaute Impliqué

BOISGONTIER

XLDnaute Barbatruc

Pièces jointes

KenDev

XLDnaute Impliqué

lys

XLDnaute Nouveau

BOISGONTIER

XLDnaute Barbatruc

Pièces jointes

KenDev

XLDnaute Impliqué

Pièces jointes

bcharef

XLDnaute Accro

Pièces jointes

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums