Erreur compilation code macro
Bonjour,
J'ai un soucis avec le code suivant auquel je voudrais rajouter une commande.
La ligne à rajouter est la suivante :
If Not Intersect(Feuil1.Range("A4:A" & Rows.Count), Target) Is Nothing Then
Set num = Feuil5.Columns(2).SpecialCells(xlCellTypeConstants).Find(Target.Value, LookIn:=xlValues)
If Not num Is Nothing Then MsgBox "Attention transfo"
Sur la macro existante qui est la suivante :
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Feuil1.Range("A4:A" & Rows.Count), Target) Is Nothing Then
Set num = Feuil5.Columns(1).SpecialCells(xlCellTypeConstants).Find(Target.Value, LookIn:=xlValues)
If Not num Is Nothing Then MsgBox "Attention reconversion"
End If
If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, Range("H2:H100")) Is Nothing Then Exit Sub
If IsEmpty(Target) Then Exit Sub
Target.Offset(0, -1).ClearContents
If (Target.Value - Target.Offset(0, -3).Value) > 30 Then
Target.Offset(0, -1).Value = "VR"
MsgBox "Attention VR"
End If
End Sub
Lorsque j'essaye d'incorporer ce code rien ne change... Pourtant je fais bien référence à la bonne feuille 5 et à la bonne colonne 2...
Merci d'avance pour votre aide
Bonjour,
A première vue, tu as besoin de remettre de l'ordre dans toutes les instructions qui permettent de quitter la procédure ...
Par exemple, pourquoi as-tu deux fois : If Target.Cells.Count > 1 Then Exit Sub
De plus, en toute logique, toutes ces instructions devraient se situer en début de code ...
Etant novice j'essaye de bidouiller un peu.. mais pour le coup sa ne fonctionne pas. Mais le code actuel que j'utilise fonctionne à merveille.
Je voudrais juste rajouter cette commande à mon code...
donc j'ai essayé comme sa :
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Feuil1.Range("A4:A" & Rows.Count), Target) Is Nothing Then
Set num = Feuil5.Columns(1).SpecialCells(xlCellTypeConstants).Find(Target.Value, LookIn:=xlValues)
If Not num Is Nothing Then MsgBox "Attention reconversion"
If Not Intersect(Feuil1.Range("A4:A" & Rows.Count), Target) Is Nothing Then
Set num = Feuil5.Columns(2).SpecialCells(xlCellTypeConstants).Find(Target.Value, LookIn:=xlValues)
If Not num Is Nothing Then MsgBox "Attention transfo"
End If
If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, Range("H2:H100")) Is Nothing Then Exit Sub
If IsEmpty(Target) Then Exit Sub
Target.Offset(0, -1).ClearContents
If (Target.Value - Target.Offset(0, -3).Value) > 30 Then
Target.Offset(0, -1).Value = "VR"
MsgBox "Attention VR"
End If
End Sub
Mais cela ne fonctionne pas....
ci joint le fichier pour que cela soit plus compréhensible...
J'aimerais avoir un message box également lorsque une immatriculation saisie en feuille 1 colonne A est existante en feuille 5 colonne B...
Re,
Sans garantie de succès ... puisque pas testé ...
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim num As Range
If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, Range("A4:A" & Rows.Count, "H2:H100")) Is Nothing Then Exit Sub
If Not Intersect(Feuil1.Range("A4:A" & Rows.Count), Target) Is Nothing Then
Set num = Feuil5.Columns(1).SpecialCells(xlCellTypeConstants).Find(Target.Value, LookIn:=xlValues)
If Not num Is Nothing Then MsgBox "Attention reconversion"
End If
If Target.Column = 8 Then
If IsEmpty(Target) Then Exit Sub
Target.Offset(0, -1).ClearContents
If (Target.Value - Target.Offset(0, -3).Value) > 30 Then
Target.Offset(0, -1).Value = "VR"
MsgBox "Attention VR"
End If
End If
End Sub
James 007 merci de ta réponse mais ce n'est pas exactement cela.
Sur mon commentaire précédent j'ai joints un fichier test cela peut surement t'aider a comprendre ma demande.
ordaz75 a écrit :James 007 merci de ta réponse mais ce n'est pas exactement cela.
Sur mon commentaire précédent j'ai joints un fichier test cela peut surement t'aider a comprendre ma demande.
Merci pour le fichier ...
Cela va permettre de ... visualiser les choses ...
Re,
A tester sur ton vrai fichier ...
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim num1 As Range
Dim num2 As Range
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Feuil1.Range("A4:A" & Rows.Count), Target) Is Nothing Then
Set num1 = Feuil5.Columns(1).SpecialCells(xlCellTypeConstants).Find(Target.Value, LookIn:=xlValues)
If Not num1 Is Nothing Then MsgBox "Attention reconversion"
Set num2 = Feuil5.Columns(2).SpecialCells(xlCellTypeConstants).Find(Target.Value, LookIn:=xlValues)
If Not num2 Is Nothing Then MsgBox "Attention transfo"
End If
If Intersect(Target, Range("H4:H100")) Is Nothing Then Exit Sub
If IsEmpty(Target) Then Exit Sub
Target.Offset(0, -1).ClearContents
If (Target.Value - Target.Offset(0, -3).Value) > 30 Then
Target.Offset(0, -1).Value = "VR"
MsgBox "Attention VR"
End If
End Sub
Parfait c'est exactement cela !!! je te remercie pour ton aide James007 !!!!!!
ordaz75 a écrit :Parfait c'est exactement cela !!! je te remercie pour ton aide James007 !!!!!!
Merci pour tee remerciements ... !!!
Ravi que cela fonctionne comme tu le voulais ...