OVH Cloud OVH Cloud

prob dans Worksheet_Change

3 réponses
Avatar
danielrv
Bonjour,
Il y a quelque jour Daniel m'a fournit un super code que j'ai eu à adapter
sur un autre fichier.
Mon nouveau problème est que si j'efface plusieurs lignes en même temps dans
la colonne 14(N), la macro inscrit un chiffre incrémenté sur ces mêmes
lignes dans la colonne A, alors que je souhaiterais que rien ne s'inscrive,
voir même que cela efface le numéro colonne A.
Merci.
(encore merci à Daniel)

Le code est :
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 And Target.Row > 3 Then
ligne = Application.Match(Target.Value, Range("s4:s500"), 0)
If Not IsNumeric(ligne) Then
On Error Resume Next
MsgBox Target.Value & " : ce chiffre ne fait pas partie de la liste."
Exit Sub
End If
Target.Offset(0, 5).Value = WorksheetFunction.Index(Range("t4:t500"), ligne,
1)
Else
On Error Resume Next
If Target.Column = 14 And Target.Row > 3 And Target.Value <> 0 Then
Target.Offset(0, -13).Value = [a2]
End If
End If
End Sub

3 réponses

Avatar
lSteph
Bonsoir,

Sauf à supprimer des lignes entières, au vu du code c'est normal!

lSteph
"danielrv" a écrit dans le message de news:

Bonjour,
Il y a quelque jour Daniel m'a fournit un super code que j'ai eu à adapter
sur un autre fichier.
Mon nouveau problème est que si j'efface plusieurs lignes en même temps
dans la colonne 14(N), la macro inscrit un chiffre incrémenté sur ces
mêmes lignes dans la colonne A, alors que je souhaiterais que rien ne
s'inscrive, voir même que cela efface le numéro colonne A.
Merci.
(encore merci à Daniel)

Le code est :
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 And Target.Row > 3 Then
ligne = Application.Match(Target.Value, Range("s4:s500"), 0)
If Not IsNumeric(ligne) Then
On Error Resume Next
MsgBox Target.Value & " : ce chiffre ne fait pas partie de la liste."
Exit Sub
End If
Target.Offset(0, 5).Value = WorksheetFunction.Index(Range("t4:t500"),
ligne, 1)
Else
On Error Resume Next
If Target.Column = 14 And Target.Row > 3 And Target.Value <> 0 Then
Target.Offset(0, -13).Value = [a2]
End If
End If
End Sub




Avatar
JB
Bonjour,

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub ' on ne peut saisir ou effacer
q'une cellule
If Target.Column = 2 And Target.Row > 3 Then
If IsEmpty(Target.Value) Then
Target.Offset(0, 5).Value = Empty ' si on efface une 1 cellule
de la colonne 2
Else
ligne = Application.Match(Target.Value, Range("s4:s500"), 0)
If Not IsNumeric(ligne) Then
MsgBox Target.Value & " : ce chiffre ne fait pas partie de la
liste."
Else
Target.Offset(0, 5).Value WorksheetFunction.Index(Range("t4:t500"), ligne, 1)
End If
End If
Else
If Target.Column = 14 And Target.Row > 3 And Target.Value <> 0 Then
Target.Offset(0, -13).Value = [a2]
End If
End If
End Sub

JB
Avatar
danielrv
Bonjour,
Merci à "JB", cela fonctionne très bien, sauf peut-être pour la partie
If IsEmpty(Target.Value) Then
Target.Offset(0, 5).Value = Empty ' si on efface une 1 cellule
de la colonne 2
que j'ai modifiée avec maladresse, je reviendrai demain pour vous faire

savoir si je m'en sors.
Bonne soirée à tous.

Bonjour,

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub ' on ne peut saisir ou effacer
q'une cellule
If Target.Column = 2 And Target.Row > 3 Then
If IsEmpty(Target.Value) Then
Target.Offset(0, 5).Value = Empty ' si on efface une 1 cellule
de la colonne 2
Else
ligne = Application.Match(Target.Value, Range("s4:s500"), 0)
If Not IsNumeric(ligne) Then
MsgBox Target.Value & " : ce chiffre ne fait pas partie de la
liste."
Else
Target.Offset(0, 5).Value > WorksheetFunction.Index(Range("t4:t500"), ligne, 1)
End If
End If
Else
If Target.Column = 14 And Target.Row > 3 And Target.Value <> 0 Then
Target.Offset(0, -13).Value = [a2]
End If
End If
End Sub

JB