[XL-2010] VBA - Fonction XRECHERCHE problème

[tienne1]

Bonjour,

J'ai utilisé une fonction VBA trouvé sur le net permettant de faire des RECHERCHEV sur des fichiers fermés.
J'ai stocké dans une feuille "paramètre" les paramètres.


Le code utilisé est le suivant :

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
 
 
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

J'ai ensuite renseigné la formule suivante dans une cellule :

=XRECHERCHEV(C4;"'"&Parametre!B2&Parametre!B3&"\[" & Parametre!B4 & "]"&Parametre!B5&"'!$Z:$AM";14)

Vous pouvez voir dans le fichier joint que la formule indique #NOM?

Pouvez-vous m'aider svp?

Merci d'avance.

[Daniel.C]

Bonsoir,

Tu le mets où, le code de la fonction dans un classeur.xlsx (c'est à dire sans macro) ?

[tienne1]

Bonjour Daniel,

Désolé, j'avais enregistré le fichier en .Xlsx.
Je vous le transfert en .xls, la macro devrait être prise en compte.

Merci d'avance pour votre retour.

[Daniel.C]

coupe le code qui est dans le module "ThisWorkbook" et colle dans un module standard. Si tu ne sais pas comment procéder, reviens le dire. Je ne peux pas tester la fonction, ne disposant pas du fichier réseau.

[tienne1]

Daniel,
en pj le doc source. Il faudra seulement modifier le chemin d'accès dans l'onglet paramètre.

Merci d'avance.

[Daniel.C]

Je ne connais rien à DAO. quand VBA arrive sur ligne :

Set rs = db.OpenRecordset(sSQL, DAO.dbOpenSnapshot)

l'exécution reprend depuis le début de la fonction. Je te retourne le classeur afin que tu puisses tester.

[tienne1]

Bonsoir Daniel,

C'est bon ca fonctionne.
Le seul problème, c'est que je ne m'attendais pas à ce que ca prenne autant de RAM que ca. Il m'est impossible d'utiliser cette fonction car ca tourne pendant des dizaines de minutes...

Auriez-vous une idée par hasard?