[已解决]两条件如何查询匹配？

小雨饰品

请教：“查询表”给出的两条件是A列（姓名）和B列（居（村）委会）内容，想要在“数据库”工作表中查找并将F列（公民身份号码）、H列（电话）、I列（出生日期）三列的结果 在“查询表”的C（公民身份号码）、D（电话）、E（出生日期）三列中匹配填写（“数据库”表的条件是a列和d列）？   谢谢！

最佳答案

月排行榜 / 总排行榜

xdragon

2014-10-9 13:02

1. Sub 二条件查找()
   
2.     Dim d As Object, arr, brr, i&, re$$(), lastrow&, drow&
   
3.     lastrow = Cells(Rows.Count, 1).End(xlUp).Row
   
4.     If lastrow < 2 Then
   
5.         Exit Sub
   
6.     Else
   
7.         arr = Sheets("数据库").Range("A1").CurrentRegion.Value
   
8.         Set d = CreateObject("scripting.dictionary")
   
9.         For i = 2 To UBound(arr)
   
10.             d(arr(i, 1) & arr(i, 4)) = i
    
11.         Next
    
12.         brr = Range("A2:B" & lastrow).Value
    
13.         ReDim re(1 To UBound(brr), 1 To 3)
    
14.         For i = 1 To UBound(brr)
    
15.             drow = d(brr(i, 1) & brr(i, 2))
    
16.             re(i, 1) = arr(drow, 6)
    
17.             re(i, 2) = arr(drow, 8)
    
18.             re(i, 3) = arr(drow, 9)
    
19.         Next
    
20.     End If
    
21.     Range("C2").Resize(UBound(re), 3) = re
    
22. End Sub

复制代码

你的问题是系统文件安装不全所致。。。换用字典+数组了

跳转到最佳答案楼层

zyouong

可以用函数的，为什么要用VBA呢？

baksy

复制以下公式，三键回车(公式复制后,点一下公式编辑栏的任意位置,先按住 ctrl、shift 两个键,然后敲enter键)，
下拉；
C2=INDEX(数据库!F:F,MATCH($A6&$B6,数据库!$A:$A&数据库!$D:$D,))
D2=INDEX(数据库!H:H,MATCH($A6&$B6,数据库!$A:$A&数据库!$D:$D,))
E2=INDEX(数据库!I:I,MATCH($A6&$B6,数据库!$A:$A&数据库!$D:$D,))

小雨饰品

baksy 发表于 2014-10-9 09:50
复制以下公式，三键回车(公式复制后,点一下公式编辑栏的任意位置,先按住 ctrl、shift 两个键,然后敲enter键 ...

谢谢，能否帮我用VBA来完成

xdragon

Sub 二条件查找()
    Dim conn As Object
    Set conn = CreateObject("adodb.connection")
    conn.Open "dsn=excel files;dbq=" & ThisWorkbook.FullName
    Range("C2").CopyFromRecordset conn.Execute("select 公民身份号码,电话,出生日期 from [查询表$A:B] a left join [数据库$A:K] b on a.姓名=b.姓名 and a.[居(村)委会]=b.[居(村)委会]")
    conn.close
    set conn=nothing
End Sub

小雨饰品

zyouong 发表于 2014-10-9 09:45
可以用函数的，为什么要用VBA呢？

谢谢，因为数据库文件数据行有5万条，文件达10M,所以我想用VBA来完成，运行速度会快点。

小雨饰品

xdragon 发表于 2014-10-9 10:36
Sub 二条件查找()
    Dim conn As Object
    Set conn = CreateObject("adodb.connection")

谢谢老师！我运行后，显示运行错误48，加载DLL错误，不知怎么才能解决？

conn.Open "dsn=excel files;dbq=" & ThisWorkbook.FullName   这句运行后显示黄色背景

xdragon

1. Sub 二条件查找()
   
2.     Dim d As Object, arr, brr, i&, re$$(), lastrow&, drow&
   
3.     lastrow = Cells(Rows.Count, 1).End(xlUp).Row
   
4.     If lastrow < 2 Then
   
5.         Exit Sub
   
6.     Else
   
7.         arr = Sheets("数据库").Range("A1").CurrentRegion.Value
   
8.         Set d = CreateObject("scripting.dictionary")
   
9.         For i = 2 To UBound(arr)
   
10.             d(arr(i, 1) & arr(i, 4)) = i
    
11.         Next
    
12.         brr = Range("A2:B" & lastrow).Value
    
13.         ReDim re(1 To UBound(brr), 1 To 3)
    
14.         For i = 1 To UBound(brr)
    
15.             drow = d(brr(i, 1) & brr(i, 2))
    
16.             re(i, 1) = arr(drow, 6)
    
17.             re(i, 2) = arr(drow, 8)
    
18.             re(i, 3) = arr(drow, 9)
    
19.         Next
    
20.     End If
    
21.     Range("C2").Resize(UBound(re), 3) = re
    
22. End Sub

复制代码

你的问题是系统文件安装不全所致。。。换用字典+数组了

小雨饰品

xdragon 发表于 2014-10-9 13:02
你的问题是系统文件安装不全所致。。。换用字典+数组了

这个很好用，太感谢老师了。

小雨饰品

xdragon 发表于 2014-10-9 13:02
你的问题是系统文件安装不全所致。。。换用字典+数组了

有时间时可否再修改一下，如附件，就是当要查找的内容[附件中的第12行]在"数据库”无信息时，代码就不能运行了（运行时错误9，下界越标）,我希望如果查不到的话此行就空着，不影响其它信息的查找匹配。谢谢！