[DAO] RECHERCHEV sur classeur fermé et variable [FAQ]

[cafeine]

Suite à deux questions, j'ai adapté les sources DAO précédentes pour pouvoir réaliser des RECHERCHEV sur des classeurs fermés dont les chemin/feuille/plage sont variables (chaine de caractères).

http://www.developpez.net/forums/sho...d.php?t=420763
http://www.developpez.net/forums/sho...d.php?t=420611

Ajouter impérativement au classeur la référence DAO.

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
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 DAO.Database
    Dim rs As DAO.Recordset
    Dim sRange As String
    Dim sSheet As String
    Dim sWbook As String
    Dim sFPath As String
    Dim sSQL   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)
 
    valRecherchee = "'" & Replace(valRecherchee, "'", "''") & "'"
 
    sSQL = "SELECT [F" & colonneIndex & "] " & _
           "FROM [" & sSheet & "$" & sRange & "] " & _
           "WHERE [F1] = " & valRecherchee
 
 
    Set db = DAO.OpenDatabase(sFPath & sWbook, False, False, "Excel 8.0;HDR=NO;")
    Set rs = db.OpenRecordset(sSQL, DAO.dbOpenSnapshot)
 
    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

exemple d'utilisation :

Code :

=XRECHERCHEV(A2;"'C:\Perso\[" & D2 & "]_Synthèse'!$A$2:$F$35";6)

[cafeine]

Hello,

voici la même fonction qui ne nécessite pas l'ajout de référence ... c'est sans doute plus simple à implémenter.

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
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 oDAO As Object
    Dim db As Object 'DAO.Database
    Dim rs As Object 'DAO.Recordset
    Dim sRange As String
    Dim sSheet As String
    Dim sWbook As String
    Dim sFPath As String
    Dim sSQL   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)
 
    valRecherchee = "'" & Replace(valRecherchee, "'", "''") & "'"
 
    sSQL = "SELECT [F" & colonneIndex & "] " & _
           "FROM [" & sSheet & "$" & sRange & "] " & _
           "WHERE [F1] = " & valRecherchee
 
 
    Set oDAO = CreateObject("DAO.DBEngine.36")
    Set db = oDAO.Workspaces(0).OpenDatabase(sFPath & sWbook, False, False, "Excel 8.0;HDR=NO;")
    Set rs = db.OpenRecordset(sSQL)
 
    If rs.EOF And rs.BOF Then
        XRECHERCHEV = "no match"
    Else
        XRECHERCHEV = rs.Fields(0)
    End If
    Set oDAO = Nothing
    Set rs = Nothing
    Set db = Nothing
End If
 
End Function

[jawed]

Bonsoir cafeine
Merci pour cette fonction ca merite des
j'ai pas ma base excel sous mes yeux mais pour etre sur votre fonction traite-elle les valeur exacte et proche de la valeur recherché ??
Nb:je n'ai pas d'experience en VBA
cordialement

[cafeine]

Hello Jawed,

contrairement à l'authentique RECHERCHEV(), la fonction ne gère par les valeurs proches. Si tu peux traduire ce que tu entends par proche en SQL, c'est possible.