AW: Noch nicht ganz am Ziel ...
23.08.2020 00:23:12
Peter
Hallo Karl-Heinz
Vielen Dank. Die Funktion macht genau, was ich brauche, obschon die Auswertung nur für Zeile 1 klappt.
Interessant ist, dass die Funktion alle Ergebnisse liefert, wenn sie über die Messagebox (vgl.
Sub Test) aufgerufen wird. Das ist ja schon eigenartig, dass eine diese Funktion funktioniert, _
wenn sie über einen
Sub aufgerufen wird, wenn die Eingabe der Funktion in der Tabelle erfolgt, dass dann alle _
Ergebnisse die über .FindNext aufgerufen werden, nicht eingetragen werden können.
Die Funktion muss ja identifizieren, auf welchen Zeilen in Worksheet "Quelle" in Spalte E " _
Apfel" steht und von diesen Zeilen müssen dann die Werte der Spalten A, B, C, D und E im Bereich A5:E9 eingetragen werden (gemäss hochgeladener Beispielmappe).
Da der erste Eintrag dieses Threads schon recht alt ist, wird der Thread dann bald im Archiv _
landen. Sobald das passiert, werde ich möglicherweise nochmals einen neuen Eintrag machen - vielleicht hat ja noch sonst jemand eine Idee, was hier das Problem ist, dass es teils funktioniert und teils nicht.
Gruss, Peter
Function FindValue(iNr As Integer, strSheet As String, lngCol As Long, _
lngColOut As Long, strFind As String) As Variant
Dim lRow As Long, rngData As Range, oFinde As Object, sErsteAdresse As String, i As Long
With ThisWorkbook.Sheets(strSheet)
lRow = .Cells(.Rows.Count, lngCol).End(xlUp).Row
With .Range(.Cells(1, 5), .Cells(lRow, 5))
Set oFinde = .Find(strFind, LookIn:=xlValues, lookat:=xlWhole)
If Not oFinde Is Nothing Then
sErsteAdresse = oFinde.Address
Do
i = i + 1
With oFinde.Offset(0, lngColOut - lngCol)
If i = iNr Then FindValue = .Value: Exit Function
End With
Set oFinde = .FindNext(oFinde)
Loop While Not oFinde Is Nothing And oFinde.Address sErsteAdresse
End If
End With
End With
End Function
Sub Test()
MsgBox FindValue(1, "Quelle", 5, 1, "Apfel")
MsgBox FindValue(2, "Quelle", 5, 1, "Apfel")
MsgBox FindValue(3, "Quelle", 5, 1, "Apfel")
MsgBox FindValue(4, "Quelle", 5, 1, "Apfel")
MsgBox FindValue(1, "Quelle", 5, 2, "Apfel")
MsgBox FindValue(2, "Quelle", 5, 2, "Apfel")
MsgBox FindValue(3, "Quelle", 5, 2, "Apfel")
MsgBox FindValue(4, "Quelle", 5, 2, "Apfel")
MsgBox FindValue(1, "Quelle", 5, 3, "Apfel")
MsgBox FindValue(2, "Quelle", 5, 3, "Apfel")
MsgBox FindValue(3, "Quelle", 5, 3, "Apfel")
MsgBox FindValue(4, "Quelle", 5, 3, "Apfel")
MsgBox FindValue(1, "Quelle", 5, 4, "Apfel")
MsgBox FindValue(2, "Quelle", 5, 4, "Apfel")
MsgBox FindValue(3, "Quelle", 5, 4, "Apfel")
MsgBox FindValue(4, "Quelle", 5, 4, "Apfel")
MsgBox FindValue(1, "Quelle", 5, 5, "Apfel")
MsgBox FindValue(2, "Quelle", 5, 5, "Apfel")
MsgBox FindValue(3, "Quelle", 5, 5, "Apfel")
MsgBox FindValue(4, "Quelle", 5, 5, "Apfel")
End Sub
In der Tabelle (Beispiel Spalte A) sehen eingetragenen Funktionen mit den Argumenten wie Folgt aus:
=FindValue(1;"Quelle";5;SPALTE();"Apfel")
=FindValue(2;"Quelle";5;SPALTE();"Apfel")
=FindValue(3;"Quelle";5;SPALTE();"Apfel")
=FindValue(4;"Quelle";5;SPALTE();"Apfel")
Da es vorkommen kann, dass der gesuchte Wert nicht viermal vorkommt, werde ich einen möglichen Fehler mit der Funktion WENNFEHLER abfangen.