[已解决]历遍两表查询相同的问题

席幕容

附件 查询相同.zip (369.05 KB, 下载次数: 17)

2015-3-15 09:19 上传

点击文件名下载附件
谢谢老师！

最佳答案

月排行榜 / 总排行榜

蓝桥玄霜

2015-3-15 11:03

1. Sub lqxs()
   
2. Dim Arr2, i&, Arr3, x$, d, n&
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. Sheet1.Activate
   
5. Cells.ClearContents
   
6. Arr2 = Sheet2.[a1].CurrentRegion
   
7. For i = 2 To UBound(Arr2)
   
8.     x = Arr2(i, 51) & "," & Arr2(i, 52)
   
9.     d(x) = i
   
10. Next
    
11. Arr3 = Sheet3.[a1].CurrentRegion
    
12. For i = 2 To UBound(Arr3)
    
13.     x = Arr3(i, 51) & "," & Arr3(i, 52)
    
14.     If d.exists(x) Then
    
15.         n = n + 1
    
16.         Cells(n, 1).Resize(1, UBound(Arr2, 2)) = Application.Index(Arr2, d(x), 0)
    
17.         Cells(n + 1, 1).Resize(1, UBound(Arr2, 2)) = Application.Index(Arr3, i, 0)
    
18.         n = n + 2
    
19.     End If
    
20. Next
    
21. End Sub
    

复制代码

跳转到最佳答案楼层

蓝桥玄霜

1. Sub lqxs()
   
2. Dim Arr2, i&, Arr3, x$, d, n&
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. Sheet1.Activate
   
5. Cells.ClearContents
   
6. Arr2 = Sheet2.[a1].CurrentRegion
   
7. For i = 2 To UBound(Arr2)
   
8.     x = Arr2(i, 51) & "," & Arr2(i, 52)
   
9.     d(x) = i
   
10. Next
    
11. Arr3 = Sheet3.[a1].CurrentRegion
    
12. For i = 2 To UBound(Arr3)
    
13.     x = Arr3(i, 51) & "," & Arr3(i, 52)
    
14.     If d.exists(x) Then
    
15.         n = n + 1
    
16.         Cells(n, 1).Resize(1, UBound(Arr2, 2)) = Application.Index(Arr2, d(x), 0)
    
17.         Cells(n + 1, 1).Resize(1, UBound(Arr2, 2)) = Application.Index(Arr3, i, 0)
    
18.         n = n + 2
    
19.     End If
    
20. Next
    
21. End Sub
    

复制代码