Appliquer la fonction RechercheV en VBA

Version imprimable

1 pièce(s) jointe(s)

Bonjour,

SVP aidez moi :hola:

Étant nouveau dans la programmation, j'ai fais une fonction RechercheV dans mon code VBA.
Cependant, le résultat ne s'affiche que quand on clique sur la cellule (Ce qui ne me plait pas du tout).

Je veux une affichage automatique de la valeur du RechercheV quand on sélectionne un élément de la liste déroulante correspondante.

Merci d'avance de votre aide :ave:

ci-contre le code vba de la fonction

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
 
Dim res As Variant
Dim mavaleur As Variant
Dim maPlage As Range
Dim macolonne As Single
Dim valeurproche As Boolean
 
' Fonction RechercheV
Function RECHERCHEV(Valeur_Cherchee As Variant, Table_matrice As Range, No_index_col As Single, Optional Valeur_proche As Boolean)
    If Valeur_Cherchee = "" Then
        MsgBox "La valeur recherchée est vide", _
        vbInformation, "Hey"
    Else
        RECHERCHEV = Application.WorksheetFunction.VLookup(Valeur_Cherchee, Table_matrice, No_index_col, Valeur_proche)
    End If
End Function
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Selection.Cells.CountLarge > 1 Then
    Else
        ligne = ActiveCell.Row
        ' Validation de données
        With Range("B" & ligne).Validation
            .Delete
        End With
 
        ' Gestion de validation des données Case à cocher de Statut nouveauté web
        If Not Intersect(Target, Range("B1:B20")) Is Nothing Then
            liste = "=Feuil2!$A$2:$A$7"
            With Range("B" & ligne).Validation
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=liste
            End With
        End If
 
        ' RechercheV pour la colonne ID
        If Not Intersect(Target, Range("A1:A20")) Is Nothing Then
            If Not Target.Address = "$A$1" Then
                Set maPlage = Sheets("Feuil2").Range("A1:B7")
                macolonne = 2
                valeurproche = False
                mavaleur = Cells(ligne, 2).Value
 
                res = RECHERCHEV(mavaleur, maPlage, macolonne, valeurproche)
                Cells(ligne, 1).Value = res
            End If
        End If
 
    End If
End Sub

En PJ le classeur XLS

version : EXCEL 2010

Bonjour,

créer une fonction portant le même nom que la fonction elle-même (en français), c'est pas très conseillé.

Le problème que tu rencontres, c'est que tu réalises tout en même temps, dans l’événement de changement de sélection (création de la liste de validation ET rechercheV)

Or, il faut scinder en deux l'opération :

- au changement de cellule : création du menu déroulant (SelectionChange)
- à la sélection d'une valeur dans le menu déroulant : application du RechercheV (Change)

Dans un module standard, la procédure pour créer le menu déroulant
Code:

1 2 3 4 5 6 Sub MajValidation(MaCellule As Range, Liste As String) With MaCellule.Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Liste End With End Sub
Dans le module de la feuille, les procédures évènementielles :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 Dim Liste As String, Tableaurecherche As ListObject Private Sub Worksheet_SelectionChange(ByVal Target As Range) Liste = "=Feuil2!$A$2:$A$7" Set Tableaurecherche = ThisWorkbook.Worksheets("Feuil2").ListObjects(1) If Selection.Cells.CountLarge > 1 Then Exit Sub If Not Intersect(Target, Range("B1:B20")) Is Nothing Then MajValidation Target, Liste End Sub Private Sub Worksheet_Change(ByVal Target As Range) If Selection.Cells.CountLarge > 1 Then Exit Sub If Not Intersect(Target, Range("B1:B20")) Is Nothing Then On Error Resume Next res = Application.WorksheetFunction.VLookup(Target.Value, Tableaurecherche.Range, 2, False) On Error GoTo 0 On Error GoTo fin Application.EnableEvents = False If Not IsError(res) Then Target.Offset(0, -1).Value = res Else MsgBox "Recherche non aboutie !" Target.Offset(0, -1).Value = "" End If End If fin: Application.EnableEvents = True End Sub
J'ai volontairement laissé le rechercheV dans la procédure évènementielle, pour raison pratique de portée des variables, mais il serait préférable également de déporter ceci dans le module standard

Finalement, j'ai trouvé la réponse après 2 jours de "remue méninges" .
ci-contre le code pour ceux qui auront les mêmes problèmes que moi.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
 
Dim liste As String
' RechercheV
Dim res As Variant
Dim mavaleur As Variant
Dim maPlage As Range
Dim macolonne As Single
Dim valeurproche As Boolean
Dim ligne As Integer
' Fonction RechercheV
Function RECHERCHEV(Valeur_Cherchee As Variant, Table_matrice As Range, No_index_col As Single, Optional Valeur_proche As Boolean)
    If Valeur_Cherchee = "" Then
        MsgBox "La valeur recherchée est vide", _
        vbInformation, "Hey"
    Else
        RECHERCHEV = Application.WorksheetFunction.VLookup(Valeur_Cherchee, Table_matrice, No_index_col, Valeur_proche)
    End If
End Function
 
 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Selection.Cells.CountLarge > 1 Then
    Else
        ligne = ActiveCell.Row
        If Not Intersect([B1:B20], Target) Is Nothing And Target.Count = 1 Then
            ' RechercheV pour la colonne ID
            If Not Target.Address = "$A$1" Then
                Set maPlage = Sheets("Feuil2").Range("A1:B7")
                macolonne = 2
                valeurproche = False
                mavaleur = Cells(ligne, 2).Value
                ' Appel de la fonction RechercheV
                res = RECHERCHEV(mavaleur, maPlage, macolonne, valeurproche)
                ' Pour l'affichage : passe le resulatat à la cellule
                Cells(ligne, 1).Value = res
            End If
        End If
    End If
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Selection.Cells.CountLarge > 1 Then
    Else
        ligne = ActiveCell.Row
        ' Validation de données
        With Range("B" & ligne).Validation
            .Delete
        End With
 
        ' Gestion de validation des données Case à cocher de Statut nouveauté web
        If Not Intersect(Target, Range("B1:B20")) Is Nothing Then
            ' La feuille de la liste dépendante
            liste = "=Feuil2!$A$2:$A$7"
            With Range("B" & ligne).Validation
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=liste
            End With
        End If
 
    End If
End Sub

BON COURAGE

11/09/2020, 11h25
joe.levrai

Je vois que tu as compris par toi-même, c'est bien !

En revanche, réalise en pas à pas ta procédure Change.

Tu constateras que tout ton process se réalise deux fois de suite.

La raison est que lors de l'écriture de la valeur du RechercheV, tu appelles à nouveau la procédure Change (puisque la valeur de la cellule est modifiée).

D'où la neutralisation des évènements (Application.EnableEvents) dans ma proposition ;)

Citation:

Envoyé par joe.levrai

Bonjour,

Bonjour joe.levrai,
Veuillez m'excuser j'ai pas eu notification de votre réponse et merci pour l'attention portée à mon problème.

Citation:

Envoyé par joe.levrai

créer une fonction portant le même nom que la fonction elle-même (en français), c'est pas très conseillé.

Oui, j’avoue que c'est pas une bonne pratique :marteau:

Citation:

Envoyé par joe.levrai

Le problème que tu rencontres, c'est que tu réalises tout en même temps, dans l’événement de changement de sélection (création de la liste de validation ET rechercheV)

Or, il faut scinder en deux l'opération :

- au changement de cellule : création du menu déroulant (SelectionChange)
- à la sélection d'une valeur dans le menu déroulant : application du RechercheV (Change)

Exactement, je que j'ai tenté de faire.
Citation:
Envoyé par joe.levrai
Dans un module standard, la procédure pour créer le menu déroulant
Code:

1 2 3 4 5 6 Sub MajValidation(MaCellule As Range, Liste As String) With MaCellule.Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Liste End With End Sub
Dans le module de la feuille, les procédures évènementielles :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 Dim Liste As String, Tableaurecherche As ListObject Private Sub Worksheet_SelectionChange(ByVal Target As Range) Liste = "=Feuil2!$A$2:$A$7" Set Tableaurecherche = ThisWorkbook.Worksheets("Feuil2").ListObjects(1) If Selection.Cells.CountLarge > 1 Then Exit Sub If Not Intersect(Target, Range("B1:B20")) Is Nothing Then MajValidation Target, Liste End Sub Private Sub Worksheet_Change(ByVal Target As Range) If Selection.Cells.CountLarge > 1 Then Exit Sub If Not Intersect(Target, Range("B1:B20")) Is Nothing Then On Error Resume Next res = Application.WorksheetFunction.VLookup(Target.Value, Tableaurecherche.Range, 2, False) On Error GoTo 0 On Error GoTo fin Application.EnableEvents = False If Not IsError(res) Then Target.Offset(0, -1).Value = res Else MsgBox "Recherche non aboutie !" Target.Offset(0, -1).Value = "" End If End If fin: Application.EnableEvents = True End Sub
J'ai volontairement laissé le rechercheV dans la procédure évènementielle, pour raison pratique de portée des variables, mais il serait préférable également de déporter ceci dans le module standard
D'accord je vais essayer votre méthodologie pour voir.

Si vous me permettez, j'ai une question pour

Code:

On error

j'ai vue que vous en avez 3x de suite.
Vous pouvez m'expliquer svp

11/09/2020, 11h36
joe.levrai

Il est utilisé à deux reprises.

La première, c'est dans le cas où le RechercheV n'aboutis pas. La procédure planterait car il est impossible de définir la valeur renvoyée par la formule (en gros, c'est une erreur comme une formule utilisée côté Excel)
On neutralise l'éventuelle erreur d'execution et on continue le déroulé (On Error Resume Next)
On teste ensuite si la variable res est une erreur. Si ce n'est pas le cas, on écrit la valeur
On rétablit la gestion courante d'erreur tout de suite après (On Error Goto 0)

La seconde, c'est une sécurité liée à la neutralisation des évènements.
Si la procédure plante (et contrairement à la neutralisation de l'actualisation de l'affichage), ce paramètre ne se réinitialise pas. Ainsi, les évènements resteraient neutralisés.

Donc, on indique qu'en cas d'erreur, on saute la procédure pour aller à l'étiquette définie (On Error Goto "fin")

et en toute fin de procédure, on place l'étiquette "fin", qui remettra en place les évènements (que la procédure ai planté ou non)
11/09/2020, 11h38
JemaCodeur

Citation:

Envoyé par joe.levrai

Oui c'est ok je vais faire comme vous. erreur de débutant :arf:

Citation:

Envoyé par joe.levrai

Merci joe.levrai, pour vos explications aussi limpide.

Je vais juste vous embêtez encore une fois car dans le code j'ai vu que vous avez zappé ma fonction RechercheV, C'était pas nécessaire ou bien c'est pas une bonne pratique ?
11/09/2020, 12h00
Philippe Tulliez
Bonjour JemaCodeur,
Pour bien comprendre les procédures événementielles, je conseille la lecture de
- Les évènements dans la feuille de calcul Excel
- Les évènements du module objet ThisWorkbook, dans Excel
11/09/2020, 12h56
JemaCodeur
Citation:
Envoyé par Philippe Tulliez

Bonjour JemaCodeur,
Pour bien comprendre les procédures événementielles, je conseille la lecture de

Les évènements dans la feuille de calcul Excel
Les évènements du module objet ThisWorkbook, dans Excel
Bonjour,
Merci pour les liens, ça sera ma lecture du weekend. ;)

Au contraire, découper en petite fonctions et procédure des actions, c'est fortement conseillé. ca permet une maintenance du code plus simple, et une réutilisation possible dans d'autres procédures.

Voici en déportant RechercheV dans une fonction séparée

Module standard :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Sub MajValidation(MaCellule As Range, Liste As String)
    With MaCellule.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Liste
    End With
End Sub
 
Function MaRechercheV(ValeurCherchee As String, TableauRecherche As Range, ColonneRecherche As Long, Optional Valeur_proche As Boolean = False) As Variant
    On Error Resume Next
        MaRechercheV = Application.WorksheetFunction.VLookup(ValeurCherchee, TableauRecherche, ColonneRecherche, Valeur_proche)
    On Error GoTo 0
End Function

Module de la feuille :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Dim Liste As String, TableauRecherche As ListObject
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Liste = "=Feuil2!$A$2:$A$7"
Set TableauRecherche = ThisWorkbook.Worksheets("Feuil2").ListObjects(1)
    If Selection.Cells.CountLarge > 1 Then Exit Sub
    If Not Intersect(Target, Range("B1:B20")) Is Nothing Then MajValidation Target, Liste
End Sub
 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Res As Variant
    If Selection.Cells.CountLarge > 1 Then Exit Sub
    If Not Intersect(Target, Range("B1:B20")) Is Nothing Then
        Res = MaRechercheV(Target.Value, TableauRecherche.Range, 2, False)
        On Error Goto fin
        Application.EnableEvents = False
            If Not IsError(Res) Then
                Target.Offset(0, -1).Value = Res
            Else
                MsgBox "Recherche non aboutie !"
                Target.Offset(0, -1).Value = ""
            End If
    End If
fin: Application.EnableEvents = True
End Sub

11/09/2020, 14h02
JemaCodeur

D'accord je vois, vous avez même réglé par votre code un autres souci que j'avais dans mon code mais qui n'était bloquant.

merci vraiment :resolu::bravo: