Liste déroulante

Le
Denys
Bonjour,
En colonne B, j'ai une liste déroulante de plusieurs noms.
Dépendamment du nom choisi, en colonne C il y a une liste déroulante
en fonction du choix de la colonne B. Il en va de même pour les
colonnes D et E.

Avec le code qui suit, si quelqu'un efface le nom de la colonne B, le
reste de la ligne s'efface. Ce pendant, j'aimerais qu'il en soit de
même si l'usager change le nom de la colonne B, car s'il passe de
Pierre à Jean, ce qui est écrit en colonne C,D et E reste même si les
liste déroulante elles changent.

Voici le code:

Private Sub Worksheet_Change(ByVal Target As Range)

'On Error Resume Next
Application.ScreenUpdating = False
With ActiveSheet
Dim DerL As Long

'If Range("B11").Value = "" Then Exit Sub

DerL = [B65000].End(xlUp)(2).Row

Range("B11:B" & DerL).Name = "All"

If Not Intersect(Range("All"), Target) Is Nothing
Then 'Il faudrait ici que même un changement devrait appeler la
procédure Enlever lignes, pas seulement si la cellule est vide.
Call EnleverLignes
[B65000].End(xlUp).Select
End If

End With
Application.ScreenUpdating = True
End Sub

Merci pour votre temps

Denys
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
MichD
Le #25265722
Bonjour,

Voici un fichier exemple à partir de ce que j'ai compris.
http://cjoint.com/?CCgtkBOHjB1

Attention : il y a du code dans le ThisWorkbook du classeur
et une déclaration d'une variable dans le module1

Le code principale dans la feuille où l'action se déroule :

'----------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim DerL As Long, Nb As Long, Are As Range
Dim Temp As Range, Ligne As Long, Gestion_Erreur As String

On Error GoTo Gestion_Erreur

Set Temp = Intersect(Range("All"), Target)
If Not Temp Is Nothing Then
Application.ScreenUpdating = False
Application.EnableEvents = False

For Each Are In Temp.Areas
Nb = Are.Rows.Count
For a = Nb To 1 Step -1
If Not IsNumeric(Application.Match(Are(Nb), T, 0)) Then
Err = 0
If Are(Nb) <> "" Then
Are.Offset(, 1).Resize(, 3).Delete xlUp
Else
Are.Resize(, 4).Delete xlUp
End If
End If
Next
Next
DerL = [B65000].End(xlUp)(2).Row
Range("B11:B" & DerL).Name = "All"
Ligne = Range("B" & Rows.Count).End(xlUp).Row
If Ligne < 11 Then Ligne = 11
T = Range("B11:B" & Ligne)
Application.ScreenUpdating = True
Application.EnableEvents = True
End If
Exit Sub

Gestion_Erreur:
Application.ScreenUpdating = True
Application.EnableEvents = True
MsgBox Err.Number & ", " & Err.Description

End Sub
'----------------------------------------


MichD
---------------------------------------------------------------
Denys
Le #25265842
Bonjour Denis,

Merci beaucoup....je ne veux juste pas éliminer la ligne mais effacer
les données apparaissant dans les cellules adjacentes....

Mais à bien y penser, ta solution serait la plus simple.... je vais
juste y ajouter un message avertissant l'utilisateur que les données
seront effacées....

Merci beaucoup pour ton temps....encore une fois !!! :-)

Denys
MichD
Le #25265832
Si tu veux seulement effacer les données,
utilise "Clearcontents" au lieu de "Delete"


MichD
---------------------------------------------------------------
Denys
Le #25265892
On Mar 6, 2:09 pm, "MichD"
Si tu veux seulement effacer les donn es,
utilise "Clearcontents" au lieu de "Delete"

MichD
---------------------------------------------------------------



Excellent.... Merci !!!

Denys
Publicité
Poster une réponse
Anonyme