AW: VBA Find über 2 Spalten
08.03.2023 18:51:23
Yal
Hallo Herbert,
die etwa komplizierte Variante geht über einen Dictionary.
Public Dic As Object
Const cTrenner = ";"
Public Sub Dic_herstellen()
Dim Z As Range
Dim Key As String
'sammeln
Set Dic = CreateObject("Scripting.Dictionary")
With Worksheets("xyz")
For Each Z In Range(.Range("A1"), .Cells(Rows.Count, "A").End(xlUp))
Key = Z.Value & cTrenner & Z.Offset(0, 1).Value
Dic(Key) = Dic(Key) & cTrenner & Z.Row
Next
End With
End Sub
Function SpalteAundB_suchen(ByVal TextA As String, ByVal TextB As String) As Long()
Dim Key As String
SpalteAundB_suchen = Array() 'Dummy Init, UBound ist dann -1. Das ist die Default-Value
Key = TextA & cTrenner & TextB
If Dic.Exists(Key) Then
SpalteAundB_suchen = Split(Mid(Dic(Key), Len(cTrenner) + 1), cTrenner) 'ohne führende Trenner
End If
End Function
Sub Test()
Dim Erg
with ...
Erg = SpalteAundB_suchen(.List(.ListIndex, 0), .List(.ListIndex, 1))
Select Case UBound(Erg)
Case -1: MsgBox "nichts vorhanden"
Case 0: MsgBox "nur eine Zeile gefunden: " & Erg(0)
Case Else: MsgBox "mehrere Ergebnisse: " & Join(Erg, ", ")
End Select
End With
End Sub
Diese macht nur Sinn, wenn die Liste lang ist, mehrfach nacheinander abgefargt wird und sich während eine Verarbeitung nicht ändert (sonst muss neu erzeugt werden). Diese Version ist so aufgestellt, dass es mehrere Treffer geben könnte.
Ansonsten sollte die von Gerd vorgeschlagene Methode auch recht schnell sein :
Function SpalteAundB_inArr_suchen(ByVal TextA As String, ByVal TextB As String) As Long
Dim Arr
Dim i
With Worksheets("Tabelle1")
Arr = Range(.Range("B1"), .Cells(Rows.Count, "A").End(xlUp)) 'top-right / bottom-left-Definition, Falls B nicht vollständig befüllt wäre.
For i = 1 To UBound(Arr, 1)
If LCase(Arr(i, 1)) = LCase(TextA) And LCase(Arr(i, 2)) = LCase(TextB) Then
SpalteAundB_inArr_suchen = i
Exit For
End If
Next
End With
End Function
VG
Yal