Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Liste déroulante

4 réponses
Avatar
Denys
Bonjour,
En colonne B, j'ai une liste d=E9roulante de plusieurs noms.
D=E9pendamment du nom choisi, en colonne C il y a une liste d=E9roulante
en fonction du choix de la colonne B. Il en va de m=EAme 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=EAme si l'usager change le nom de la colonne B, car s'il passe de
Pierre =E0 Jean, ce qui est =E9crit en colonne C,D et E reste m=EAme si les
liste d=E9roulante elles changent.

Voici le code:

Private Sub Worksheet_Change(ByVal Target As Range)

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

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

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

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

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

End With
Application.ScreenUpdating =3D True
End Sub

Merci pour votre temps

Denys

4 réponses

Avatar
MichD
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
---------------------------------------------------------------
Avatar
Denys
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
Avatar
MichD
Si tu veux seulement effacer les données,
utilise "Clearcontents" au lieu de "Delete"


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

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



Excellent.... Merci !!!

Denys