|
Hallo,
ich habe keine Frage oder Problem.
Nachstehend lege ich nur den LVerweis – das ist der SVerweis der nach Links geht – hier ab.
(Schon klar – SVerweis steht für Spaltenverweis. Somit bricht LVerweis mit dieser Semantik, aber SVerweis2 klingt bescheuert, und SVerweisLinks auch.)
Das ist auch nur ein Kinkerlitzchen. Excel-Liebhaber und gerade Controller fanden das aber immer toll. Wer es mag, soll es nutzen.
Denn die Index-Variante, als Alternative aus den Bordmitteln, die mag fast keiner.
Für die Anwender. Die Logik ist genau die gleiche wie beim SVerweis, mit nur 2 Unterschieden.
- das vierte Argument ist nur ein leerer Platzhalter – ich wollte keine „ungefähre Suche“ verwenden. Der Parameter tut also gar nichts und es ist damit immer die exakte Suche.
2. Es gibt noch einen fünften Parameter. Auch der ist optional. Default ist 0 und liefert den Wert aus der Zielzelle. Der Wert 1 für diesen Parameter liefert die Adresse der getroffenen Zielzelle.
Wer das nicht mag, kann es ja entsprechend für sich anpassen.
Und ja, auch das kann man anders und noch schlanker lösen. Diese Variante ist aber für die meisten Leute am leichtesten lesbar, glaube ich zumindest.
Public Function LVerweis(searchcriteria As Variant, matrix As Range, columnindex As Long, Optional NA As Boolean, Optional typ As Byte) As Variant
Dim wbRng As Workbook
Dim wsRng As Worksheet
Dim StaCel, EndCel, Matchrng, MatchCell As Range
Dim CntCols, StaRow, EndRow, StaCol, EndCol As Long
If typ < 0 Or typ > 1 Then
LVerweis = CVErr(xlErrRef)
Exit Function
End If
CntCols = matrix.Columns.Count
If CntCols < columnindex Or columnindex < 1 Then
LVerweis = CVErr(xlErrRef)
Exit Function
End If
Set wbRng = Workbooks(matrix.Parent.Parent.Name)
Set wsRng = wbRng.Sheets(matrix.Parent.Name)
Set StaCel = wsRng.Range(matrix(1).Address)
Set EndCel = wsRng.Range(matrix(matrix.Cells.Count).Address)
StaRow = StaCel.Row
StaCol = StaCel.Column
EndRow = EndCel.Row
EndCol = EndCel.Column
Set Matchrng = Range(wsRng.Cells(StaRow, EndCol), wsRng.Cells(EndRow, EndCol))
If IsError(Application.VLookup(searchcriteria, Matchrng, 1, 0)) Then
LVerweis = CVErr(xlErrNA)
Exit Function
End If
Set MatchCell = wsRng.Cells(WorksheetFunction.Match(searchcriteria, Matchrng, 0) + StaRow - 1, EndCol)
If typ = 0 Then
If IsError(MatchCell.Offset(0, (columnindex * -1) + 1).Value) Then
LVerweis = MatchCell.Offset(0, (columnindex * -1) + 1).Value
Exit Function
End If
LVerweis = MatchCell.Offset(0, (columnindex * -1) + 1)
If LVerweis = vbNullString Then
LVerweis = vbNullString
End If
ElseIf typ = 1 Then
Set MatchCell = Range(MatchCell.Offset(0, (columnindex * -1) + 1).Address)
LVerweis = MatchCell.Address
End If
End Function
Beste Grüße
chicken_wizard
|