Schneller Weg zu Vlookup und mehrere Ergebnisse zurückgeben?

Question

Ich habe über einen Tag hier in Stackoverflow gesucht und finde keine Antwort auf das, was ich versuche zu tun. Alles, was ich brauche, ist ein VBA-Code, der Vlookups und die multiplen Ergebnisse zurückgibt,

Eg; Der Wert für die Suche ist in Blatt1 A1, Daten sind in Blatt2 Spalten A1: B40000, entsprechen den Werten in Blatt2 A1: A40000 und gibt die Werte aus Blatt2 Spalte B1: B40000 zurück.

Hinweis: Es ist möglich, bis zu 5000 Übereinstimmungen in Blatt 2 A1: A40000 zu finden.

Ich habe verschiedene Möglichkeiten versucht, wie Array-Formel (sehr langsam), UDF (langsam), VBA-AutoFilter (langsam). Gibt es eine Möglichkeit, dies schnell zu tun?

Kann jemand helfen? Vielen Dank im Voraus!

Answer 1

Code mit 40.000 Einträgen getestet, und dies schließt im Grunde sofort:

Private Sub Worksheet_Change(ByVal Target As Range) 

    Dim wb As Workbook 
    Dim ws1 As Worksheet 
    Dim ws2 As Worksheet 
    Dim vLoookupVal As Variant 
    Dim vValues As Variant 
    Dim aResults() As Variant 
    Dim lResultCount As Long 
    Dim i As Long 
    Dim lIndex As Long 

    Set wb = ActiveWorkbook 
    Set ws1 = Me     'This is the sheet that contains the lookup value 
    Set ws2 = wb.Sheets("Sheet2") 'This is the sheet that contains the table of values 

    Application.EnableEvents = False 

    If Not Intersect(Target, ws1.Range("A1")) Is Nothing Then 
     ws1.Columns("B").ClearContents 'Clear previous results 
     vLoookupVal = Intersect(Target, ws1.Range("A1")).Value 
     lResultCount = WorksheetFunction.CountIf(ws2.Columns("A"), Target.Value) 
     If lResultCount = 0 Then 
      MsgBox "No matches found for [" & vLoookupVal & "]", , "No Matches" 
     Else 
      ReDim aResults(1 To lResultCount, 1 To 1) 
      lIndex = 0 
      vValues = ws2.Range("A1:B" & ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row).Value 
      For i = LBound(vValues, 1) To UBound(vValues, 1) 
       If vValues(i, 1) = vLoookupVal Then 
        lIndex = lIndex + 1 
        aResults(lIndex, 1) = vValues(i, 2) 
       End If 
      Next i 
      ws1.Range("B1").Resize(lResultCount).Value = aResults 
     End If 
    End If 

    Application.EnableEvents = True 

End Sub 

Answer 2

Pivot-Tabelle würde Dinge beschleunigen und Sie können den Filter als Suchfunktion verwenden?

Answer 3

Ihr Autofilter Code Vielleicht nicht dieses mögen wurde?

Private Sub Main() 
    Dim lookUpVal As Variant 

    lookUpVal = Worksheets("Sheet1").Range("A1").Value 
    With Worksheets("Sheet2") 
     With .Range("A1", .Cells(.Rows.Count, "A").End(xlUp)) 
      If WorksheetFunction.CountIf(.Cells, lookUpVal) = 0 Then Exit Sub 
      .AutoFilter field:=1, Criteria1:= lookUpVal 
      .Resize(,2).SpecialCells(xlCellTypeVisible).Copy Worksheets("Sheet1").Range("B1") 
     End With 
     .AutoFilterMode= False 
    End With 
End Sub