Question

我已经在Stackoverflow中找了一天多的时间，找不到我想要做的答案。我只需要一个Vlook代码，Vlookups并返回多个结果，

EG;查找值在sheet1 A1中，数据在sheet2列A1：B40000中，匹配sheet2 A1：A40000中的值并返回Sheet2列B1：B40000中的值。

注意：可以在sheet2 A1：A40000中找到最多5000个匹配。

我尝试了几种方法，例如数组公式（非常慢），UDF（SLOW），VBA-AutoFilter（SLOW）。有没有办法快速做到这一点？

有人可以帮忙吗？非常感谢提前！

Answer 1

使用40,000个条目对代码进行测试，这基本上立即完成：

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

也许您的AutoFilter代码不是这样的？

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

Answer 3

数据透视表会加快速度，你可以使用过滤器作为搜索功能吗？

更快的Vlookup方式并返回多个结果？

3 个答案: