Option Explicit
'UDF (User Defined Function)
Public Function getTableVal(Table As Variant, Key As Variant, FieldName As Variant) As Variant
Dim rngData As Excel.Range
Dim strFormula As String
Dim vntResult As Variant
If Not IsObject(Table) Then
getTableVal = CVErr(XlCVError.xlErrRef)
'Anm.: Man könnte an dieser Stelle auch noch eine Lösung für
' 2D-Datenfelder implementieren.
'
ElseIf TypeOf Table Is Excel.Range Then
'Datenbereich refrenzieren
'Simplerweise gehen wir hier davon aus, dass die Kopfzeile nur eine Zeile beansprucht,
'und jene wird hier ausgeschlossen.
Set rngData = Table.Resize(Table.Rows.Count - 1).Offset(1)
strFormula = "=INDEX(%TABLE%,MATCH(%KEY%,%KEYS%,0)+1,MATCH(""%FIELD%"",%FIELDS%,0))"
strFormula = Replace$(strFormula, "%TABLE%", Table.Address(External:=True))
strFormula = Replace$(strFormula, "%KEY%", Trim$(Key))
strFormula = Replace$(strFormula, "%FIELD%", Trim$(FieldName))
strFormula = Replace$(strFormula, "%KEYS%", rngData.Columns(1).Address(External:=True))
strFormula = Replace$(strFormula, "%FIELDS%", rngData.Rows(1).Offset(-1).Address(External:=True))
On Error Resume Next
'Debug.Print "Formula :" & strFormula
vntResult = Application.Evaluate(strFormula)
On Error GoTo 0
getTableVal = vntResult
Else
getTableVal = CVErr(XlCVError.xlErrRef)
Exit Function
End If
End Function
Die UDF kann übrigens nicht get heißen, da dies ein reserviertes Schlüsselwort in VBA ist.
Gruß
|