Grüezi liekki
Na dann eben nochmal in verständlich 
(Versuch):
Exceltabelle. Zahnräder stehen in Zeile 1 (B1, C1, D1, …,
Y1) und in Spalte A (A2, A3, A4 …, A33).
A B C D … Y
1 72 70 68 … 72
2 84 15 22 20 20
3 82 10 20 15 18
4 72 9 18 5 9
5 70 8 5 5
. . . . . … .
. . . . . … .
33 2 . . . … 0,5
Wenn ich also in meinem „Suchfeld“ z. B.
18 eingebe, bekomme ich C4 und Y3 als Wert zurück. Wie schaffe
ich es nun, in seperaten leeren Zellen - um bei diesem
Beispiel zu bleiben - die Werte 70 und 72 (C1 und A1) als auch
die Werte 72 und A3 (Y1 und Y3) angezeigt zu bekommen?
Eine WENN-Abfrage ist bei der Menge von Daten in meinen Augen
nicht mehr wirklich sinnvoll. Gibt es da keine elegantere
Lösung?
Du könntest eine Benutzerdefinierte Funktion wie die unten stehende verwenden, der Du deinen Suchwert als Bezug sowie den Bereich (inkl. den Zeilen/Spalten-Überschriften) als Parameter übergibst.
Markiere dann einen Bereich der zwei Zellen breit und mehrere Zellen lang ist - gib dort die folgende Formel ein:
=Search_Gear(A40;A1:Y33)
und schliesse die Eingabe mit Strg+Umschalt+Return ab (als Matrix-Formel eben).
A40 ist hier das Suchfeld
A1:Y33 ist hier dein Datenfeld
Solange keine Übereinstimmung mit dem Suchfeld gefunden wird gibt der Bereich überall eine ‚0‘ aus - werden Übereinstimmungen gefunden erscheinen diese zeilenweise im Bereich mit der Formel.
Public Function Search\_Gear(Wert As Long, rngBereich As Range) As Variant
Dim rngSearch As Range
Dim rngZelle As Range
Dim lngColCorr As Long
Dim lngRowCorr As Long
Dim lngCount As Long
Dim arGears() As Long
ReDim arGears(Application.Caller.Rows.Count - 1, Application.Caller.Columns.Count - 1)
'Suchbereich festelegen und Korrekturwerte bestimmen
With rngBereich
Set rngSearch = rngBereich.Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1)
lngColCorr = .Range("A1").Column - 1
lngRowCorr = .Range("A1").Row - 1
End With
'Prüfen ob Suchwert überhaupt vorhanden
lngCount = WorksheetFunction.CountIf(rngSearch, Wert)
If lngCount \> 0 Then
lngCount = 0
'Jede Zelle im Suchbereich prüfen
For Each rngZelle In rngSearch
'Wenn Wert gefunden Zeile/Spalte - Überschrift auslesen
'un in Array schreiben
If rngZelle.Value = Wert Then
arGears(lngCount, 0) = rngBereich(rngZelle.Row - lngRowCorr, 1)
arGears(lngCount, 1) = rngBereich(1, rngZelle.Column - lngColCorr)
lngCount = lngCount + 1
End If
Next rngZelle
End If
'Array zurückgeben
Search\_Gear = arGears()
End Function
–
Mit freundlichen Grüssen
Thomas Ramel
