[已解决]跨表提取不重复数据（都可以学习）

文轩馨婷

要求：提取“表1”“表2”中领货人不重复的姓名在“汇总表”A列（想要的效果如M列）
如附件!!!

如果能用函数解决是最好了！（最近在整理“提取不重复数据“的函数解法）

在此先谢过了！！

谢谢grf1973老师的VBA解法！！
谢谢qinqh_yl老师的函数解法！！

最佳答案

月排行榜 / 总排行榜

qinqh_yl

2015-4-3 11:50

只有两个表还是可以用函数求出来：
A2=IF(ROW()-1>SUM(IFERROR(1/COUNTIF(表1!$B$2:$D$4,表1!$B$2:$D$4),0)),INDIRECT("表2!"&TEXT(MIN(IF((COUNTIF(A$1:A1,表2!$B$2:$D$4)=0)*(表2!$B$2:$D$4<>""),ROW($2:$4)*100+COLUMN($B:$D),9999)),"R#C00"),),INDIRECT("表1!"&TEXT(MIN(IF((COUNTIF(A$1:A1,表1!$B$2:$D$4)=0)*(表1!$B$2:$D$4<>""),ROW($2:$4)*100+COLUMN($B:$D),9999)),"R#C00"),))&""

B2=IF(A2="","",SUM(COUNTIF(INDIRECT("表"&{"1","2"}&"!B:D"),A2)))
均为数组公式。

跳转到最佳答案楼层

grf1973

1. Sub tt()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     For Each sh In Worksheets
   
4.         If sh.Name <> ActiveSheet.Name Then
   
5.             arr = sh.[a1].CurrentRegion
   
6.             For i = 2 To UBound(arr)
   
7.                 For j = 2 To UBound(arr, 2)
   
8.                     If arr(i, j) <> "" Then d(arr(i, j)) = d(arr(i, j)) + 1
   
9.                 Next
   
10.             Next
    
11.         End If
    
12.     Next
    
13.     [a2].Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))
    
14. End Sub
    

复制代码

文轩馨婷

grf1973 发表于 2015-4-3 11:21

谢谢！完全解决了！{:25:}

只是VBA不懂！（能否加上中文注释）

最佳先留着，在看看有没有用函数解决的！

心正意诚身修

文轩馨婷 发表于 2015-4-3 11:31
谢谢！完全解决了！

只是VBA不懂！（能否加上中文注释）

我也在等函數的解法.等著學習一下.

qinqh_yl

只有两个表还是可以用函数求出来：
A2=IF(ROW()-1>SUM(IFERROR(1/COUNTIF(表1!$B$2:$D$4,表1!$B$2:$D$4),0)),INDIRECT("表2!"&TEXT(MIN(IF((COUNTIF(A$1:A1,表2!$B$2:$D$4)=0)*(表2!$B$2:$D$4<>""),ROW($2:$4)*100+COLUMN($B:$D),9999)),"R#C00"),),INDIRECT("表1!"&TEXT(MIN(IF((COUNTIF(A$1:A1,表1!$B$2:$D$4)=0)*(表1!$B$2:$D$4<>""),ROW($2:$4)*100+COLUMN($B:$D),9999)),"R#C00"),))&""

B2=IF(A2="","",SUM(COUNTIF(INDIRECT("表"&{"1","2"}&"!B:D"),A2)))
均为数组公式。

文轩馨婷

qinqh_yl 发表于 2015-4-3 11:50
只有两个表还是可以用函数求出来：
A2=IF(ROW()-1>SUM(IFERROR(1/COUNTIF(表1!$B$2:$D$4,表1!$B$2:$D$4),0 ...

解决了！！{:25:}

老师，可否讲讲思路？？

grf1973

代码很简单。。。。只是学了代码之后再也没有心思钻研公式了。。。。。

1. Sub tt()
   
2.     Set d = CreateObject("scripting.dictionary")      '设立字典
   
3.     For Each sh In Worksheets     '遍历所有工作表
   
4.         If sh.Name <> ActiveSheet.Name Then        '工作表名不等于当前工作表名
   
5.             arr = sh.[a1].CurrentRegion       '工作表数据入数组
   
6.             For i = 2 To UBound(arr)       '对数组行循环
   
7.                 For j = 2 To UBound(arr, 2)       '对数组列循环
   
8.                     If arr(i, j) <> "" Then d(arr(i, j)) = d(arr(i, j)) + 1         '数组每个元素去重+1
   
9.                 Next
   
10.             Next
    
11.         End If
    
12.     Next
    
13.     [a2].Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))        '显示结果
    
14. End Sub

复制代码

文轩馨婷

grf1973 发表于 2015-4-3 13:23
代码很简单。。。。只是学了代码之后再也没有心思钻研公式了。。。。。

呵呵呵...{:011:}

谢谢！

等论坛开课后也得参加学习！

笨帅帅

学习下  谢谢各位老师~~

yangkai_lin

学习了。。