Création d'un liste déroulante

bonjour

J’ai une première liste (dans feuil1) ou il aurait des nom (1//) , ces nom seront déjà inscrit dans une autre feuille (feuil2) avec des information plus détallé mais parfois le but est de jute écrire le nom et que les information ce copie de la feuil2 a la feuil1 sur les cases qui leur corresponde (ce code je l’ai déjà fait)

Ensuite ça peut arriver d’avoir le même nom mais avec des informations différentes donc j’ai remodifié le code pour que quand il détecte un nom multiple alors il transforme les cases des colonnes F-G-H en liste déroulante avec juste les choix avec le même nom (déjà fait).

C’est là que j’arrive à ce que je cherche, je voudrais savoir comment je fais pour que quand je modifie l’une de ces 3 liste déroulante (disons que j’ai modifier la case de la colonne F), qu’il effectue une recherche directement pour voir si le nom et ce qui est dans la case colonne F est unique, si oui alors écrire le reste des informations dans le tableau feuil1 si non alors passer à la suivante case (sachant que je ne peut pas avoir les information (3// ;4// ;5// ;2//) mélanger entre eux dans le même nom.

un autre problème que j'ai c'est que dans la liste déroulante le séparatif c'est la( , )et pas les case par exemple (case1 =1,2) (case2 = 6) dans la liste déroulante on aurait 1 et 16 si qq sait ce que je doit changer je suis a lécoute

'modifie le code pour que quand j'écrit un mot avec une
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim feuilleSource As Worksheet
    Dim feuilleDestination As Worksheet
    Dim cell As Range
    Dim motRecherche As String
    Dim derniereLigne As Long
    Dim i As Long
    Dim occurences As Long
    Dim references As Object
    Dim prixUnitaires As Object
    Dim fournisseurs As Object
    Dim rngRef As Range
    Dim rngPrix As Range
    Dim rngFournisseur As Range

    Set feuilleSource = ThisWorkbook.Sheets("Feuil1")
    Set feuilleDestination = ThisWorkbook.Sheets("Feuil2")

    If Not Intersect(Target, feuilleSource.Columns("D")) Is Nothing Then
        For Each cell In Target
            If cell.Column = 4 Then
                motRecherche = LCase(cell.Value)
                occurences = 0

                Set references = CreateObject("Scripting.Dictionary")
                Set prixUnitaires = CreateObject("Scripting.Dictionary")
                Set fournisseurs = CreateObject("Scripting.Dictionary")

                derniereLigne = feuilleDestination.cells(feuilleDestination.Rows.Count, "D").End(xlUp).Row
                                Set rngFournisseur = feuilleSource.cells(cell.Row, "F")
                With rngFournisseur.Validation
                    .Delete
                    .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator:=xlBetween
                    .IgnoreBlank = True
                    .InCellDropdown = True
                    .InputTitle = ""
                    .ErrorTitle = ""
                    .InputMessage = ""
                    .ErrorMessage = ""
                    .ShowInput = True
                    .ShowError = True
                End With
                Set rngFournisseur = feuilleSource.cells(cell.Row, "G")
                With rngFournisseur.Validation
                    .Delete
                    .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator:=xlBetween
                    .IgnoreBlank = True
                    .InCellDropdown = True
                    .InputTitle = ""
                    .ErrorTitle = ""
                    .InputMessage = ""
                    .ErrorMessage = ""
                    .ShowInput = True
                    .ShowError = True
                End With
                Set rngFournisseur = feuilleSource.cells(cell.Row, "H")
                With rngFournisseur.Validation
                    .Delete
                    .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator:=xlBetween
                    .IgnoreBlank = True
                    .InCellDropdown = True
                    .InputTitle = ""
                    .ErrorTitle = ""
                    .InputMessage = ""
                    .ErrorMessage = ""
                    .ShowInput = True
                    .ShowError = True
                End With
                For i = 1 To derniereLigne
                    If LCase(feuilleDestination.cells(i, "D").Value) = motRecherche Then
                        occurences = occurences + 1
                        references(feuilleDestination.cells(i, "F").Value) = 1
                        prixUnitaires(feuilleDestination.cells(i, "G").Value) = 1
                        fournisseurs(feuilleDestination.cells(i, "E").Value) = 1
                    End If
                Next i

                If occurences > 1 Then

                    Set rngRef = feuilleSource.cells(cell.Row, "G")
                    feuilleSource.cells(cell.Row, "G") = ""
                    With rngRef.Validation
                        .Delete
                        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Join(references.keys, ",")
                    End With

                    Set rngPrix = feuilleSource.cells(cell.Row, "H")
                    feuilleSource.cells(cell.Row, "H") = ""
                    With rngPrix.Validation
                        .Delete
                        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Join(prixUnitaires.keys, "")
                    End With

                    Set rngFournisseur = feuilleSource.cells(cell.Row, "F")
                    feuilleSource.cells(cell.Row, "F") = ""
                    With rngFournisseur.Validation
                        .Delete
                        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Join(fournisseurs.keys, ",")
                    End With

                    Exit Sub
                ElseIf occurences = 1 Then
                    For i = 1 To derniereLigne
                        If LCase(feuilleDestination.cells(i, "D").Value) = motRecherche Then
                            feuilleSource.cells(cell.Row, "G").Value = feuilleDestination.cells(i, "F").Value
                            feuilleSource.cells(cell.Row, "H").Value = feuilleDestination.cells(i, "G").Value
                            feuilleSource.cells(cell.Row, "F").Value = feuilleDestination.cells(i, "E").Value
                            feuilleSource.cells(cell.Row, "I").Formula = "=H" & cell.Row & "*E" & cell.Row
                            Exit For
                        End If
                    Next i
                End If

                If cell.Value = "" Then
                    feuilleSource.cells(cell.Row, "F").ClearContents
                    feuilleSource.cells(cell.Row, "G").ClearContents
                    feuilleSource.cells(cell.Row, "H").ClearContents

                    Set rngFournisseur = feuilleSource.cells(cell.Row, "F")
                    With rngFournisseur.Validation
                        .Delete
                        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator:=xlBetween
                        .IgnoreBlank = True
                        .InCellDropdown = True
                        .InputTitle = ""
                        .ErrorTitle = ""
                        .InputMessage = ""
                        .ErrorMessage = ""
                        .ShowInput = True
                        .ShowError = True
                    End With
                    Set rngFournisseur = feuilleSource.cells(cell.Row, "G")
                    With rngFournisseur.Validation
                        .Delete
                        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator:=xlBetween
                        .IgnoreBlank = True
                        .InCellDropdown = True
                        .InputTitle = ""
                        .ErrorTitle = ""
                        .InputMessage = ""
                        .ErrorMessage = ""
                        .ShowInput = True
                        .ShowError = True
                    End With
                    Set rngFournisseur = feuilleSource.cells(cell.Row, "H")
                    With rngFournisseur.Validation
                        .Delete
                        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator:=xlBetween
                        .IgnoreBlank = True
                        .InCellDropdown = True
                        .InputTitle = ""
                        .ErrorTitle = ""
                        .InputMessage = ""
                        .ErrorMessage = ""
                        .ShowInput = True
                        .ShowError = True
                    End With
                End If
            End If
        Next cell
    End If
End Sub
0teste-11111.xlsm (35.31 Ko)
Rechercher des sujets similaires à "creation liste deroulante"