[已解决]请求老师帮帮忙。谢谢！

kingdows

求各位老师们帮帮忙，我这个表要怎么做啊。就是表1引用表2和表3里的数据。表1中家庭人口只填上数量就行  比如表2中序号1单元格占用了8行，户主是聂，家庭人口有8人，在表1中的家庭人口那一格就只要填上8就可以了或者利用表2和表3生成表1也可以，就是把表2里的户主姓名  性别  年龄再加上表3里的联系电话 生成表1 而且表1中家庭人员那一列就是按表2中序号1单元格占用了8行，户主是聂，家庭人口有8人，在表1中的家庭人口那一格就只要填上8
在线急求！！！！谢谢
样表.rar (21.61 KB, 下载次数: 3)

2016-12-6 20:41 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

grf1973

2016-12-7 08:52

姓名一般不具有唯一性。建议用身份证号什么的做为主键。

1. Sub tt()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     Set d1 = CreateObject("scripting.dictionary")
   
4.     Set d2 = CreateObject("scripting.dictionary")
   
5.     Set d3 = CreateObject("scripting.dictionary")
   
6.    
   
7.     arr = Sheet2.[a1].CurrentRegion
   
8.     For i = 2 To UBound(arr)
   
9.         d1(arr(i, 3)) = arr(i, 4)   '年龄
   
10.         d2(arr(i, 3)) = arr(i, 5)   '性别
    
11.         d(arr(i, 3)) = Sheet2.Cells(i, 1).MergeArea.Cells.Count   '家庭人数
    
12.     Next
    
13.    
    
14.     arr = Sheet3.[a1].CurrentRegion
    
15.     For i = 1 To UBound(arr)
    
16.         d3(arr(i, 3)) = arr(i, 11)     '电话
    
17.     Next
    
18.    
    
19.     Sheet1.[b2:e1000].ClearContents
    
20.     arr = Sheet1.[a1].CurrentRegion
    
21.     For i = 2 To UBound(arr)
    
22.         x = arr(i, 1)
    
23.         arr(i, 2) = d2(x)
    
24.         arr(i, 3) = d1(x)
    
25.         arr(i, 4) = d3(x)
    
26.         arr(i, 5) = d(x)
    
27.     Next
    
28.     Sheet1.[a1].CurrentRegion = arr
    
29. End Sub
    

复制代码

跳转到最佳答案楼层

grf1973

姓名一般不具有唯一性。建议用身份证号什么的做为主键。

1. Sub tt()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     Set d1 = CreateObject("scripting.dictionary")
   
4.     Set d2 = CreateObject("scripting.dictionary")
   
5.     Set d3 = CreateObject("scripting.dictionary")
   
6.    
   
7.     arr = Sheet2.[a1].CurrentRegion
   
8.     For i = 2 To UBound(arr)
   
9.         d1(arr(i, 3)) = arr(i, 4)   '年龄
   
10.         d2(arr(i, 3)) = arr(i, 5)   '性别
    
11.         d(arr(i, 3)) = Sheet2.Cells(i, 1).MergeArea.Cells.Count   '家庭人数
    
12.     Next
    
13.    
    
14.     arr = Sheet3.[a1].CurrentRegion
    
15.     For i = 1 To UBound(arr)
    
16.         d3(arr(i, 3)) = arr(i, 11)     '电话
    
17.     Next
    
18.    
    
19.     Sheet1.[b2:e1000].ClearContents
    
20.     arr = Sheet1.[a1].CurrentRegion
    
21.     For i = 2 To UBound(arr)
    
22.         x = arr(i, 1)
    
23.         arr(i, 2) = d2(x)
    
24.         arr(i, 3) = d1(x)
    
25.         arr(i, 4) = d3(x)
    
26.         arr(i, 5) = d(x)
    
27.     Next
    
28.     Sheet1.[a1].CurrentRegion = arr
    
29. End Sub
    

复制代码

kingdows

有没有老师在的。烦请解决一下。谢谢，还有就是名字和表里对应不上的就空着可以了。

kingdows

谢谢老师，我看看

kingdows

请问。姓名那一列要怎么输入？