Problème avec liste déroulante

Bonjour à tous,

J'ai un petit soucis avec mon fichier et j'espère que vous allez pouvoir m'aider à le résoudre

En gros:

1- Je sélectionne un secteur et ensuite un ensemble.

2- Je supprime ensuite la sélection qui est dans la case ensemble . (je vais essayer de mettre en place une suppression automatique des que la liste secteur s'active).

3- Lorsque que je sélectionne un nouveau secteur le fichier passe en erreur.

Le débugage m'amène ici:

Private Sub ExtractionEnsembleUniques(strSecteur As String)

Dim dic As Object, tmp

Dim i As Integer

If Trim(strSecteur) = "" Then

Range("L3") = "choisir un secteur"

GoTo Validation

End If

tmp = Me.Range("A6", Me.Cells(Rows.Count, 2).End(xlUp)).Value

Set dic = CreateObject("scripting.dictionary")

For i = 1 To UBound(tmp)

If LCase(tmp(i, 1)) = LCase(strSecteur) Then

dic(tmp(i, 2)) = tmp(i, 2)

End If

Next

Validation:

With Range("L3")

.Validation.Delete

.Validation.Add xlValidateList, Formula1:=Join(dic.items, ",")

End With

End Sub

Merci d'avance

Bonjour

J'ai bien une solution mais j'ai remarqué un truc

Quelquefois (assez souvent) la validation ne passe pas, il faut ré-sélectionner le secteur pour que la liste de validation arrive

Je ne sais pas pourquoi, je ne sais si ce n'est que moi

En attendant modifies ta macro ExtractionEnsembleUniques (parties surlignées)

Validation:
   With Range("L3")
        .Validation.Delete
        If dic.Count > 0 Then
          .Validation.Add xlValidateList, Formula1:=Join(dic.items, ",")
        End If
   End With
End Sub

Il y a du mieux

Encore deux soucis:

1-Quelquefois (assez souvent) la validation ne passe pas, il faut ré-sélectionner le secteur pour que la liste de validation arrive

Je ne sais pas pourquoi, je ne sais si ce n'est que moi.

-->En effet et je ne sais pas pourquoi.

2-Si je supprime directement la valeur dans la cellule Secteur, j'ai encore un message d'erreur.

Merci d'avance

Bonjour

Pour le problème n°2

Modifies ton code

Ajoutes les lignes surlignées

Enlèves les lignes surlignées

Private Sub ExtractionEnsembleUniques(strSecteur As String)
    Dim dic As Object, tmp
    Dim i As Integer
    If Trim(strSecteur) = "" Then
     With Range("L3")
        .Validation.Delete
       .Value = "choisir un secteur"
      End With
      Exit Sub
     [surligner=#FFFF80]'GoTo Validation
    End If
    tmp = Me.Range("A6", Me.Cells(Rows.Count, 2).End(xlUp)).Value
    Set dic = CreateObject("scripting.dictionary")
    For i = 1 To UBound(tmp)
        If LCase(tmp(i, 1)) = LCase(strSecteur) Then
            dic(tmp(i, 2)) = tmp(i, 2)
        End If
    Next
[surligner=#FFFF80]'Validation:
   With Range("L3")
        .Validation.Delete
        If dic.Count > 0 Then
          .Validation.Add xlValidateList, Formula1:=Join(dic.items, ",")
        End If
   End With
End Sub

Et pour le problème n°1 quelqu'un sait pourquoi ?

Ca fonctionne, Merci

Il ne reste plus qu'a voir cette histoire de liste déroulante qui n’apparaît pas tous le temps

Bonjour

Je pense avoir compris

Quand tu remplis ton tableau Tmp toutes les lignes ne sont pas affichées, et la fonction Me.Cells(Rows.Count, 2).End(xlUp) ne te retourne pas la dernière ligne non vide de la base, mais seulement la dernière ligne non vide affichée

Modifies ta macro (lignes surlignées déplacées)

Private Sub Worksheet_Change(ByVal Target As Range)

 'Recherche
  If Not Intersect(Range("L2:L3"), Target) Is Nothing Then
  Application.ScreenUpdating = False
 If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
    If Target.Address(0, 0) = "L2" Then
        Application.EnableEvents = False
        Range("L3") = ""
        ExtractionEnsembleUniques Target.Value
        Application.EnableEvents = True
    End If
   [barrer]'Application.ScreenUpdating = False[/barrer]
   [barrer]'If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False[/barrer]
    With Range("A5:B3247")

Tant qu'à faire un autre bug

Essayes d'afficher le secteur STEP : Chez moi plantage

Pour y remédier

Toujours pareil les lignes surlignées : Macro ExtractionEnsembleUniques

    For i = 1 To UBound(tmp)
        If LCase(tmp(i, 1)) = LCase(strSecteur) Then
          If Trim(tmp(i, 2)) <> "" Then
            dic(tmp(i, 2)) = tmp(i, 2)
          End If
        End If
    Next

Ca fonctionne parfaitement.

Encore merci

Bonjour,

Je pensais avoir résolu mon problème, mais ce n’est pas le cas…

En effet si je mets à jour le tableau, ma liste déroulante « secteur » ne ce met pas à jour .

Le problème c’est que si j’actualise ma liste déroulante des que l’on modifier la feuille ma liste déroulante déconne (certaines valeurs n’apparaisse pas).

Auriez-vous une idée ?

Merci

Bonsoir

Peux tu mettre en ligne la dernière version du programme afin de chercher une solution sur un fichier valable

Voila

Bonsoir

Si j'ai compris le problème

C'est parfait,

Je vais pouvoir me servir cela pour d'autre fichier.

Merci