求助！求助！工作簿内多表查询返回查询结果，麻烦各位老师帮一下忙，谢谢！

老磨石

想实现通过身份证号逐个、逐表查询，判断所在部门。想实现结果在表内，麻烦帮忙看一下，谢谢！

lsc900707

这样查询还真的少见！

1. Sub gj23w98()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     Set d1 = CreateObject("scripting.dictionary")
   
4.     For Each sht In Sheets
   
5.         If InStr(sht.Name, "部") Then
   
6.             arr = sht.[a1].CurrentRegion
   
7.             For i = 1 To UBound(arr)
   
8.                 d(arr(i, 1)) = sht.Name
   
9.             Next
   
10.         ElseIf InStr(sht.Name, "总表") Then
    
11.             arr = sht.[a1].CurrentRegion
    
12.             For i = 1 To UBound(arr)
    
13.                 d1(arr(i, 1)) = sht.Name
    
14.             Next
    
15.         End If
    
16.     Next
    
17.     r = Cells(Rows.Count, 1).End(3).Row
    
18.     brr = Range("a1:b" & r)
    
19.     For i = 1 To UBound(brr)
    
20.         If d.exists(brr(i, 1)) Then
    
21.             brr(i, 2) = d(brr(i, 1))
    
22.         ElseIf d1.exists(brr(i, 1)) Then
    
23.             brr(i, 2) = "其它部门"
    
24.         Else
    
25.             brr(i, 2) = "无人员记录"
    
26.         End If
    
27.     Next
    
28.     Range("a1:b" & r) = brr
    
29. End Sub
    

复制代码

lsc900707

附件供测试参考：