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