如何引用vlookup返回的全部数值？

364337151

我是一名财务工作者，经常需要查找数据，但面临一个非常重复且头痛的问题，现求助论坛大神们，看看你们是否有更好的解决方案，跪谢！！


问题：我如何能够批量·一次性·引用·全部的vlookup返回的数值？

下图为数据源：


由于我的实际工作中经常有超过10万行的数据，因此需要批量操作，比如，我目前通过颜色筛选出橙色部分的数据，如下图：


想要达到的目的：我需要快速找出同一月份同一凭证号的全部数据，比如，1月的记-2，有6行数据，我希望可以一次性引用6行数据

具体表现如下：

这是一个空白表格，在左边蓝色区域，将筛选出来的凭证号（比如上图橙色数据），复制粘贴到蓝色区域，我就能在右边的紫色区域得到完整的数据。（其实通过vlookup可以返回第一行数据，但无法返回第二行数据）



最终呈现的效果，如图：



备注：我希望紫色区域是填满公式的，能够根据蓝色区域的随机值进行自动化引用，把全部数据找出来。

我已经尝试过，countif函数+vlookup函数+row函数+column函数这个组合了，如果是单个凭证号的引用是可以的，但如果我在左边蓝色区域一次性复制粘贴几十行数据的时候，此组合无效，因此跪求更好的方法！拜托各位路过的大神了！！！

364337151

有偿回复，谢谢各位大神！

css207

如果你是365版本的软件，可以使用FILTER函数

cjc209

你要以2列作为筛选条件吗?

cjc209

可以用字典法 一次性完成 或者 sql方法

cjc209

Sub 筛选结果()
    Dim dic, jg()
    Set dic = CreateObject("scripting.dictionary")
    For i = 2 To Sheet2.Range("A" & Rows.Count).End(xlUp).Row
        dic(Sheet2.Cells(i, 1).Value & "|" & Sheet2.Cells(i, 2).Value) = ""
    Next
    arr = Sheet1.[a1].CurrentRegion
    ReDim jg(1 To UBound(arr), 1 To UBound(arr, 2))
    For i = 2 To UBound(arr)
        关键字 = arr(i, 1) & "|" & arr(i, 2)
        If dic.exists(关键字) Then
            k = k + 1
            For j = 1 To UBound(arr, 2)
                jg(k, j) = arr(i, j)
            Next
        End If
    Next
    Sheet2.[d1].CurrentRegion.Offset(1) = ""
    Sheet2.[d2].Resize(k, UBound(arr, 2)) = jg
    Set dic = Nothing
End Sub

cjc209

简简单单                        

cjc209

还是传附件快些

364337151

cjc209 发表于 2023-3-25 20:31
Sub 筛选结果()
    Dim dic, jg()
    Set dic = CreateObject("scripting.dictionary")

感谢你，但我加你企鹅，要验证你叫啥名字，不如你加我？？364337151，谢谢！

WANT-T

超过10万行，就不建议使用函数了，可以考虑用vba或者数据库来操作，推荐sql处理，核心代码就一句；

1. 
   
2. Sub 提取数据()
   
3.     Dim SQL As String
   
4.     Dim Ado As Object, rng As Range
   
5.     Dim Conn_str As String
   
6.     Conn_str = ""
   
7.     Set Ado = CreateObject("Adodb.Connection")
   
8.     If Application.Version >= 11 Then
   
9.         Conn_str = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=YES"";"
   
10.     Else
    
11.         con_Str = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 8.0;HDR=YES"";"
    
12.     End If
    
13.     Ado.Open Conn_str
    
14.     With ThisWorkbook.Worksheets("筛选器 (2)")
    
15.         .Activate
    
16.        ' .Range("A1").CurrentRegion.Select
    
17.         SQL = "SELECT A.期间,A.字号,B.摘要,B.科目代码,B.科目名称,B.借方金额,B.贷方金额 " & _
    
18.                 "FROM [" & .Name & "$A1:B" & .Range("A1").CurrentRegion.Rows.Count & "] A " & _
    
19.                 "LEFT JOIN [数据$] B ON A.期间=B.期间 AND A.字号=B.凭证字号 " & _
    
20.                 "ORDER BY A.期间,A.字号"
    
21.         '.Range("d1").CurrentRegion.Offset(1).Select
    
22.         .Range("d1").CurrentRegion.Offset(1).Clear
    
23.         .Range("D2").CopyFromRecordset Ado.Execute(SQL)
    
24.         .Range("d1").CurrentRegion.Borders.LineStyle = 1
    
25.     End With
    
26.     Ado.Close
    
27. End Sub
    

复制代码