Bonjour,

J’essaie d'adapter le code de Cafeine de "Comment réaliser des RECHERCHEV sur des classeurs fermés dont les chemins, feuille et plage sont variable?" sans succès.

J'ai créé une procédure de test qui appelle la fonnction XRECHERCHEV

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
Sub test()
 
    Dim val1 As Variant
    Dim val2 As Variant
    Dim val3 As Integer
 
    val1 = "Année courante"
    val2 = "C:\Users\Eric\Documents\Excel\[Classeur1.xlsm]_Feuil1!$A$1:$F$35"
    val3 = 6
 
    XRECHERCHEV val1, val2, val3
 
End Sub
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
62
63
64
65
66
67
68
69
Option Explicit
 
Public Function XRECHERCHEV(ByVal valRecherchee As Variant, _
                            ByVal TabMatrice As Variant, _
                            ByVal colonneIndex As Integer)
 
 
If TypeName(TabMatrice) = "Range" Then
    XRECHERCHEV = Application.WorksheetFunction.VLookup(valRecherchee, _
                                                        TabMatrice, _
                                                        colonneIndex, _
                                                        True)
Else
    Dim db As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim myCmd As ADODB.Command
    Dim sRange As String
    Dim sSheet As String
    Dim sWbook As String
    Dim sFPath As String
    Dim sSQL   As String
    Dim Chemin As String
 
    sRange = Replace(Split(TabMatrice, "!")(1), "$", vbNullString)
    sSheet = Split(Split(TabMatrice, "]")(1), "'")(0)
    sWbook = Split(Split(TabMatrice, "[")(1), "]")(0)
    sFPath = Mid(Split(TabMatrice, "[")(0), 2)
    Chemin = "C" & sFPath & sWbook
 
 
    valRecherchee = "'" & Replace(valRecherchee, "'", "''") & "'"
 
 
    sSQL = "SELECT [F" & colonneIndex & "] " & _
           "FROM [" & sSheet & "$" & sRange & "] " & _
           "WHERE [F1] = " & valRecherchee
 
 
 
    Set db = New ADODB.Connection
 
    With db
 
        .Provider = "Microsoft.Jet.OLEDB.12.0"
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
            & Chemin & "; Extended Properties=""Excel 12.0;HDR=YES;"""
        .Open
 
    End With
 
 
    Set myCmd = New ADODB.Command
 
    myCmd.ActiveConnection = db
    'myCmd.CommandText = "SELECT * FROM [Feuil1$]"
    myCmd.CommandText = sSQL
    Set rs = New ADODB.Recordset
    rs.Open myCmd
 
    If rs.EOF And rs.BOF Then
        XRECHERCHEV = "no match"
    Else
        XRECHERCHEV = rs.Fields(0)
    End If
    Set rs = Nothing
    Set db = Nothing
End If
 
End Function
Le message d'erreur est le suivant:

Nom : Capture.PNG Affichages : 147 Taille : 8,8 Ko

J'ai beau essayé depuis plusieurs heures de modifier la requête sSQL. Je n'y arrive pas.

Je vous remercie de bien vouloir m'aiguiller pour trouver la solution.

Eric