多表查询引用

yangqianming

突然上面要求做月报表（近十万行数据），看了后感觉无从下手。具体需求如下：
需求：要根据单位在出生人口表、新增孕情表、避孕节育表中查找到该单位人员对应信息
痛点:1、要在三个表中查出本村去重女性人员名单（必须保证男方不同。条件是女&男）
2、数据规律性不够强
例如：单位选择北山沟月报数据如样例。
请求高手帮助，谢谢！

hzruziniu

为什么不把三张表的内容整合到一骊表内（数据库）
有了数据库你要什么样的表都可以随心所欲

729211ying

没太看懂你的附件和要求，不过去重可以用VBA的字典程序很简单

729211ying

仅供参考
Public Sub 去重多列简单()
Set d = CreateObject("scripting.dictionary")
arr = Range("a1:e" & Cells(Rows.Count, 5).End(xlUp).Row)
For i = 1 To UBound(arr)
    d(arr(i, 1)) = Array(arr(i, 2), arr(i, 3), arr(i, 4), arr(i, 5))
Next
[k1].Resize(d.Count) = Application.Transpose(d.keys)
[l1].Resize(d.Count, 4) = Application.Transpose(Application.Transpose(d.items))
End Sub

hefuqing

1. Sub 月报()
   
2. Dim arr
   
3. Set d = CreateObject("scripting.dictionary")
   
4. 
   
5. Sheets("出生人口").Select
   
6. With Sheets("出生人口")
   
7. For i = 2 To .[a65536].End(xlUp).Row
   
8. d(.Cells(i, 2).Value & "-" & .Cells(i, 6).Value) = ""
   
9. Next
   
10. End With
    
11. 
    
12. Sheets("新增孕情").Select
    
13. With Sheets("新增孕情")
    
14. For i = 2 To .[a65536].End(xlUp).Row
    
15. d(.Cells(i, 3).Value & "-" & .Cells(i, 8).Value) = ""
    
16. Next
    
17. End With
    
18. 
    
19. Sheets("避孕节育").Select
    
20. With Sheets("避孕节育")
    
21. For i = 2 To .[a65536].End(xlUp).Row
    
22. d(.Cells(i, 3).Value & "-" & .Cells(i, 6).Value) = ""
    
23. Next
    
24. End With
    
25. 
    
26. k = d.keys
    
27. t = d.items
    
28. Sheets("月报").Select
    
29. Sheets("月报").[b5].Resize(d.Count, 1) = Application.Transpose(k)
    
30. 
    
31. Sheets("出生人口").Select
    
32. arr = Sheets("出生人口").[a1].CurrentRegion
    
33. For i = 5 To d.Count + 5
    
34. For j = 2 To UBound(arr)
    
35. If Sheets("月报").Cells(i, 2) = arr(j, 2) & "-" & arr(j, 6) Then
    
36.   Sheets("月报").Cells(i, 8) = arr(j, 14)
    
37.   Sheets("月报").Cells(i, 9) = arr(j, 13)
    
38.   Sheets("月报").Cells(i, 10) = arr(j, 12)
    
39.   Sheets("月报").Cells(i, 11) = arr(j, 15)
    
40.    End If
    
41. Next
    
42. Next
    
43. 
    
44. Sheets("新增孕情").Select
    
45. arr = Sheets("新增孕情").[a1].CurrentRegion
    
46. For i = 5 To d.Count + 5
    
47. For j = 2 To UBound(arr)
    
48. If Sheets("月报").Cells(i, 2) = arr(j, 3) & "-" & arr(j, 8) Then
    
49.   Sheets("月报").Cells(i, 5) = arr(j, 12)
    
50.     Sheets("月报").Cells(i, 7) = arr(j, 14)
    
51. End If
    
52. Next
    
53. Next
    
54. 
    
55. 
    
56. Sheets("避孕节育").Select
    
57. arr = Sheets("避孕节育").[a1].CurrentRegion
    
58. For i = 5 To d.Count + 5
    
59. For j = 2 To UBound(arr)
    
60. If Sheets("月报").Cells(i, 2) = arr(j, 3) & "-" & arr(j, 6) Then
    
61.   Sheets("月报").Cells(i, 14) = arr(j, 9)
    
62.     Sheets("月报").Cells(i, 15) = arr(j, 10)
    
63. End If
    
64. Next
    
65. Next
    
66. 
    
67. Sheets("月报").Select
    
68. End Sub

复制代码

yangqianming

hefuqing 发表于 2018-8-15 17:25

粘贴到模块后显示缺少行号等错误。能做好给个附件吗？先谢谢了！

hefuqing

yangqianming 发表于 2018-8-15 20:36
粘贴到模块后显示缺少行号等错误。能做好给个附件吗？先谢谢了！

这个信息不全，如果还需要改进，联系我QQ512233031