XL 2013 recherchev en vba

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Bonjour,
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Ws As Worksheet
  Set Ws = Sheets("sources") ' Attribution de la variable Ws le nom de la feuille sources
  On Error Resume Next 'si le code produit n'existe pas,n'affiche pas d'erreur
  If Not Application.Intersect(Target, Range("I:I")) Is Nothing Then 'Sur Chgt dans une cellule colonne I
        If Target.Value <> "" Then 'Si la cellule n'est pas vide
          'Réplication de RECHERCHEV()
          ' Target.Row --> Ligne de la cellule en modification
          
          Cells(Target.Row, "J") = Application.WorksheetFunction.VLookup(Target.Value, Ws.Range("A:C"), 2, False)
          Cells(Target.Row, "K") = Application.WorksheetFunction.VLookup(Target.Value, Ws.Range("A:C"), 3, False)
          Cells(Target.Row, "N") = Cells(Target.Row, "K")
        Else
            Columns("J:N").Rows(Target.Row) = ""
        End If
    End If
End Sub
 
Bonjour,
Je sollicite votre aide sur le code que quelqu'un m'a déjà aidé.
Merci d'avance.
Cordialement,
Bonjour à tous
Ne pas mettre un Application.EnableEvents = False sur un Worksheet_Change , n'est pas une bonne idée.
Ceci traite également si la valeur saisie n'existe pas
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Ws As Worksheet
    Set Ws = Sheets("sources")    ' Attribution de la variable Ws le nom de la feuille sources
    On Error Resume Next    'si le code produit n'existe pas,n'affiche pas d'erreur
    Application.EnableEvents = False
    If Not Application.Intersect(Target, Range("I:I")) Is Nothing Then    'Sur Chgt dans une cellule colonne I
        'Réplication de RECHERCHEV()
        ' Target.Row --> Ligne de la cellule en modification

        Cells(Target.Row, "J") = Application.WorksheetFunction.VLookup(Target.Value, Ws.Range("A:C"), 2, False)
        Cells(Target.Row, "K") = Application.WorksheetFunction.VLookup(Target.Value, Ws.Range("A:C"), 3, False)
        Cells(Target.Row, "N") = Cells(Target.Row, "K")
    End If

    If Err Then Cells(Target.Row, "J") = "": Cells(Target.Row, "K") = "": Cells(Target.Row, "N") = ""
    Application.EnableEvents = True
End Sub
Nb: Ceci pourrait être traité facilement sans vba
 
Dernière édition:
Bonjour à tous
Ne pas mettre un Application.EnableEvents = False sur un Worksheet_Change , n'est pas une bonne idée.
Ceci traite également si la valeur saisie n'existe pas

Nb: Ceci pourrait être traité facilement sans vba
Bonjour Jacky 76,
Je suis nul en vba et c'est un travail de quelqu'un que j'ai envoyé, si tu peux rectifier l'erreur dans le fichier svp.
Le soucis aussi c'est que le résultat de la recherche v ne fonctionne pas si je fais une copie valeur de 1000 lignes par exemple dans la colonne clé de recherche, le traitement ne fonctionne pas tant qu'on n'entre pas une à une les clés de recherche.
Merci beaucoup
 
Re-bonjour,
Je pensais que le choix du code ne pouvait pas être remis en cause ..
Sinon les formules de @JHA sont ok, il faut juste les encadrer par un sierreur pour éviter les #N/A
VB:
=SIERREUR(RECHERCHEV(I5;Tableau2;2;FAUX);"")
Re, J'ai déjà utilisé des formules mais c'est trop lourd et c'est pour cela que quelqu'un m'a conseillé de faire le traitement sur VBA.
Cdlt,
 
Bonjour Jacky 76,
Je suis nul en vba et c'est un travail de quelqu'un que j'ai envoyé, si tu peux rectifier l'erreur dans le fichier svp.
Le soucis aussi c'est que le résultat de la recherche v ne fonctionne pas si je fais une copie valeur de 1000 lignes par exemple dans la colonne clé de recherche, le traitement ne fonctionne pas tant qu'on n'entre pas une à une les clés de recherche.
Merci beaucoup
Re..
Voir si le classeur en Pj* convient
*Modifié
 

Pièces jointes

Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
4
Affichages
235
Réponses
5
Affichages
108
Réponses
5
Affichages
150
Retour