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
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
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
Bonsoir,
Sauf à supprimer des lignes entières, au vu du code c'est normal!
lSteph
"danielrv" <novice@neuf.fr> a écrit dans le message de news:
uNOf3SqUGHA.1572@tk2msftngp13.phx.gbl...
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
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
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
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
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
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
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
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