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