VBA Pb avec macro évenementielle

Arpette · 28 Août 2010

Bonjour à toutes et à tous,
J'ai une macro qui se lance quand deux cellules sont renseignées plage (B5:C14). Mon problème est que la rechercheV qui est derrière ne se lance pas. Ci-joint mon code.
Merci pour votre aide.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim pl As Range 'déclare la variable pl (PLage)
Dim r As Range 'déclare la variable r (Recherche)

If Intersect(Target, Range("B5:C14")) Is Nothing Then Exit Sub
With Sheets("plct type essai")
    For i = 5 To 14
        If .Cells(i, 2) <> "" And .Cells(i, 3) <> "" Then
            .Cells(i, 4).Value = .Cells(i, 2).Value & .Cells(i, 3).Value
            .Cells(i + 13, 1).Value = .Cells(i, 2).Value
            .Cells(i + 27, 1).Value = .Cells(i, 2).Value
            .Cells(i + 42, 1).Value = .Cells(i, 2).Value
            .Cells(i + 56, 1).Value = .Cells(i, 2).Value
            .Cells(i + 71, 1).Value = .Cells(i, 2).Value
        End If
    Next i
End With

If Intersect(Target, Range("D5:D14")) Is Nothing Then Exit Sub
With Sheets("Nomenclature") 'prend en compte l'onglet "Nomenclature"
    Set pl = .Range("A4:A" & .Range("A65536").End(xlUp).Row) 'définit la plage de recherche
End With 'fin de la prise en compte de l'onglet "Nomenclature"
 
Set r = pl.Find(Target.Value, , xlValues, xlWhole) 'définit la recherche
If Not r Is Nothing Then 'condition : si il existe au moins une occurrence de D dans la plage pl
    'place le résultat en E et F
    Target.Offset(0, 1).Value = r.Offset(0, 3).Value
    Target.Offset(0, 2).Value = r.Offset(0, 4).Value
    
    Else 'sinon
    MsgBox "Code non trouvé !" 'message
    Exit Sub
End If
: Exit Sub

End Sub

kjin · 28 Août 2010

Re : VBA Pb avec macro évenementielle

Bonjour,
C'est un peu normal, si la cellule active n'est pas comprise dans ("B5:C14"), tu quittes la procédure !
En outre, la seconde partie ne s'appliquerait que si la cellule est comprise dans ("D5: D14")
A+
kjin

Arpette · 28 Août 2010

Re : VBA Pb avec macro évenementielle

kjin à dit:
Bonjour,
C'est un peu normal, si la cellule active n'est pas comprise dans ("B5:C14"), tu quittes la procédure !
En outre, la seconde partie ne s'appliquerait que si la cellule est comprise dans ("D5: D14")
A+
kjin

Bonjour kjin et merci, cela veut dire que ce n'esy pas possible?
@+

kjin · 28 Août 2010

Re : VBA Pb avec macro évenementielle

Re,
ça veut surtout dire qu'il faudrait que tu expliques comment s'est supposé fonctionner
A+
kjin

Arpette · 28 Août 2010

Re : VBA Pb avec macro évenementielle

kjin à dit:
Re,
ça veut surtout dire qu'il faudrait que tu expliques comment s'est supposé fonctionner
A+
kjin

Re, je me doutais bien que mon code n'était pas trop parlant. Si je renseigne les cellules Bx et Cx, je concatène en Dx. Ensuite, je recherche la valeur Dx dans la feuille "nomenclature" et je renvoie les valeurs de la 4ème et 5ème colonne de cette feuille dans les cellules Ex et Fx.
Merci pour ton aide.
@+

kjin · 28 Août 2010

Re : VBA Pb avec macro évenementielle

Re,
Ce n'est pas le code qui n'est pas explicite, c'est le résultat que tu souhaites obtenir qui ne l'est pas.
En supposant

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim pl As Range, i As Byte, r As Range

If Intersect(Target, Range("B5:C14")) Is Nothing Then Exit Sub
With Sheets("Nomenclature")
    Set pl = .Range("A4:A" & .Range("A65536").End(xlUp).Row)
End With
[COLOR="Blue"]With Sheets("plct type essai")[/COLOR]
    For i = 5 To 14
        If .Cells(i, 2) <> "" And .Cells(i, 3) <> "" Then   'condition1
            .Cells(i, 4).Value = .Cells(i, 2).Value & .Cells(i, 3).Value
            .Cells(i + 13, 1).Value = .Cells(i, 2).Value
            .Cells(i + 27, 1).Value = .Cells(i, 2).Value
            .Cells(i + 42, 1).Value = .Cells(i, 2).Value
            .Cells(i + 56, 1).Value = .Cells(i, 2).Value
            .Cells(i + 71, 1).Value = .Cells(i, 2).Value
            Set r = pl.Find(.Cells(i, 4).Value, , xlValues, xlWhole)
            If Not r Is Nothing Then                        'condition2
                .Cells(i, 5).Value = r.Offset(0, 3).Value
                .Cells(i, 6).Value = r.Offset(0, 4).Value
            Else
                MsgBox "Code non trouvé !"
            End If
        End If
    Next i
End With

End Sub

où est la feuille active, ou plutôt, pourquoi spécifer un nom de feuille puisque par définition une macro événementielle s'applique à la feuille dans laquelle le code est implémenté ?
où est la référence à la cellule cible (Target) dans le code ?
Comme je ne vois ni l'un ni l'autre, pourquoi une macro événementielle ?
Bref je ne comprends toujours pas
A+
kjin

Arpette · 28 Août 2010

Re : VBA Pb avec macro évenementielle

kjin à dit:
Re,
Ce n'est pas le code qui n'est pas explicite, c'est le résultat que tu souhaites obtenir qui ne l'est pas.
En supposant

Code:

Private Sub Worksheet_Change(ByVal Target As Range) Dim pl As Range, i As Byte, r As Range If Intersect(Target, Range("B5:C14")) Is Nothing Then Exit Sub With Sheets("Nomenclature") Set pl = .Range("A4:A" & .Range("A65536").End(xlUp).Row) End With [COLOR="Blue"]With Sheets("plct type essai")[/COLOR] For i = 5 To 14 If .Cells(i, 2) <> "" And .Cells(i, 3) <> "" Then 'condition1 .Cells(i, 4).Value = .Cells(i, 2).Value & .Cells(i, 3).Value .Cells(i + 13, 1).Value = .Cells(i, 2).Value .Cells(i + 27, 1).Value = .Cells(i, 2).Value .Cells(i + 42, 1).Value = .Cells(i, 2).Value .Cells(i + 56, 1).Value = .Cells(i, 2).Value .Cells(i + 71, 1).Value = .Cells(i, 2).Value Set r = pl.Find(.Cells(i, 4).Value, , xlValues, xlWhole) If Not r Is Nothing Then 'condition2 .Cells(i, 5).Value = r.Offset(0, 3).Value .Cells(i, 6).Value = r.Offset(0, 4).Value Else MsgBox "Code non trouvé !" End If End If Next i End With End Sub

où est la feuille active, ou plutôt, pourquoi spécifer un nom de feuille puisque par définition une macro événementielle s'applique à la feuille dans laquelle le code est implémenté ?
où est la référence à la cellule cible (Target) dans le code ?
Comme je ne vois ni l'un ni l'autre, pourquoi une macro événementielle ?
Bref je ne comprends toujours pas
A+
kjin

Re, merci kjin, çà fonctionne impécable. La feuille active est "plct type essai", j'ai pris l'obtion macro événementielle pour qu'elle démarre dès que je renseigne les cellule B et C de cette feuille et ensuite faire une rechercheV dans la foulée. Peut-être y a-t-il une autre solution. Ci-joint le lien de mon fichier (renseigner dans feuille "plct type essai" cellule B7 et C7 avec même données que B6 et B7.
@+
http://cjoint.com/?iCpyyVMfJB

Fo_rum · 28 Août 2010

Re : VBA Pb avec macro évenementielle

Salut

Kjin a raison quant au "With Sheets("plct type essai")" inutile.
Autre façon :
la recherche lancée à la saisie de la "matière" sachant que "l'article" est déjà choisi.
et sans boucler sur les autres lignes.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim i As Byte, pl As Range,  r As Range
  If Target.Count > 1 Then Exit Sub
  If Intersect(Target, Range("C5:C14")) Is Nothing Then Exit Sub
  If Target.Offset(, -1) = "" Then Exit Sub
  i = Target.Row
  Cells(i, 4) = Cells(i, 2) & Cells(i, 3)
  With Sheets("Nomenclature")
    Set pl = .Range("A4:A" & .Range("A65536").End(xlUp).Row)
    Set r = pl.Find(Cells(i, 4), , xlValues, xlWhole)
    If r Is Nothing Then 
      MsgBox "Code non trouvé !"
      Cells(i, 4) = ""
      Exit Sub
    End If
    Cells(i, 5) = r.Offset(, 3)
    Cells(i, 6) = r.Offset(, 4)
  End With
  Cells(i + 13, 1) = Cells(i, 2)
  Cells(i + 27, 1) = Cells(i, 2)
  Cells(i + 42, 1) = Cells(i, 2)
  Cells(i + 56, 1) = Cells(i, 2)
  Cells(i + 71, 1) = Cells(i, 2)
End Sub

Arpette · 28 Août 2010

Re : VBA Pb avec macro évenementielle

Fo_rum à dit:

Salut

Kjin a raison quant au "With Sheets("plct type essai")" inutile.
Autre façon :
la recherche lancée à la saisie de la "matière" sachant que "l'article" est déjà choisi.
et sans boucler sur les autres lignes.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim i As Byte, pl As Range,  r As Range
  If Target.Count > 1 Then Exit Sub
  If Intersect(Target, Range("C5:C14")) Is Nothing Then Exit Sub
  If Target.Offset(, -1) = "" Then Exit Sub
  i = Target.Row
  Cells(i, 4) = Cells(i, 2) & Cells(i, 3)
  With Sheets("Nomenclature")
    Set pl = .Range("A4:A" & .Range("A65536").End(xlUp).Row)
    Set r = pl.Find(Cells(i, 4), , xlValues, xlWhole)
    If r Is Nothing Then 
      MsgBox "Code non trouvé !"
      Cells(i, 4) = ""
      Exit Sub
    End If
    Cells(i, 5) = r.Offset(, 3)
    Cells(i, 6) = r.Offset(, 4)
  End With
  Cells(i + 13, 1) = Cells(i, 2)
  Cells(i + 27, 1) = Cells(i, 2)
  Cells(i + 42, 1) = Cells(i, 2)
  Cells(i + 56, 1) = Cells(i, 2)
  Cells(i + 71, 1) = Cells(i, 2)
End Sub

Bonsoir Fo_rum, c'est vrai ça fonctionne bien et moins de ligne, tu sais quand on débute en VBA, souvent on se complique la vie.
Merci à toi et à kjin.
A bientôt, je suis de mariage, j'y retourne.
@+

Effectuez une recherche sur Excel Downloads...

VBA Pb avec macro évenementielle

Arpette

XLDnaute Impliqué

kjin

XLDnaute Barbatruc

Arpette

XLDnaute Impliqué

kjin

XLDnaute Barbatruc

Arpette

XLDnaute Impliqué

kjin

XLDnaute Barbatruc

Arpette

XLDnaute Impliqué

Fo_rum

XLDnaute Accro

Arpette

XLDnaute Impliqué

Discussions similaires

Nous accordons de l'importance à votre vie privée