Benutzerdef.Funktion funzt nicht
26.10.2007 10:42:00
Walter
ich habe mir mittels der Find-Methode eine SVerweis ähnliche Funktion gebastelt, die jedoch im gegensatz zum SVerweis auch mehrere Treffer finden kann und diese dann addiert.
Funktioniert auch prima im Direktbereich, jedoch nicht als Worksheet Function (Tabellenblatt-Funktion)
Ich erhalte den Fehlerwert Wert#!
Hier der Code:
Private Function FindSum(Suchbegriff As Range, Bereich As Range, Optional intOffset As Integer = _
0) As Double
'Berücksichtigt alle Treffer in einem bestimmten Bereich und Summiert die Treffer
'Mit Offset kann man auf Werte in Nachbarzellen verweisen (ähnlich dem SVerweis)
Dim rngArray As Range
Dim rngTreffer As Range
Dim dblSumme As Double
Set rngArray = Find_Range(Suchbegriff.Value, Bereich)
If Not rngArray Is Nothing Then
For Each rngTreffer In rngArray
If IsNumeric(rngTreffer) Then
dblSumme = rngTreffer.Offset(0, intOffset).Value + dblSumme
End If
Next rngTreffer
End If
FindSum = dblSumme
End Function
Private Function Find_Range(Find_Item As Variant, _
Search_Range As Range, _
Optional LookIn As Variant, _
Optional LookAt As Variant, _
Optional MatchCase As Boolean) As Range
Dim c As Range
Dim firstAddress As String
If IsMissing(LookIn) Then LookIn = xlValues 'xlFormulas
If IsMissing(LookAt) Then LookAt = xlWhole 'xlPart '
If IsMissing(MatchCase) Then MatchCase = False
With Search_Range
Set c = .Find(What:=Find_Item, _
LookIn:=LookIn, _
LookAt:=LookAt, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=MatchCase, _
SearchFormat:=False)
If Not c Is Nothing Then
Set Find_Range = c
firstAddress = c.Address
Do
Set Find_Range = Union(Find_Range, c)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address firstAddress
End If
End With
End Function
Die FindRange ist überigens nicht von mir und gibt ein Array aller gefundenen Zellen zurück.
Gruß Walter