[已解决]重复值提取

cyj153

重复值提取.rar (1.95 KB, 下载次数: 32)

2012-10-2 11:11 上传

点击文件名下载附件
根据条件提取其重复类型的名称。谢谢！

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2012-10-2 11:38

重复值提取.rar (10.41 KB, 下载次数: 69)

2012-10-2 11:38 上传

点击文件名下载附件

跳转到最佳答案楼层

hwc2ycy

考虑如果重复值不止一个，则重复值之间用逗号相隔，显示在单元格内。

1. Sub 重复值提取()
   
2.     Dim sCFMC As String
   
3.     Dim arr
   
4.     Dim dic As Object
   
5.     Dim i As Long
   
6.     Dim arrKey, arrItem
   
7.     Dim sRst As String
   
8.     On Error Resume Next
   
9.     Set dic = CreateObject("scripting.dictionary")
   
10.     arr = Range("a2:b" & [a2].End(xlDown).Row).Value
    
11.     sCFMC = [I2].Value
    
12.     For i = 1 To UBound(arr)
    
13.         If arr(i, 1) = sCFMC Then
    
14.             dic(arr(i, 2)) = dic(arr(i, 2)) + 1
    
15.         End If
    
16.     Next
    
17.     arrKey = dic.Keys
    
18.     arrItem = dic.items
    
19.     For i = 0 To UBound(arrItem)
    
20.         If arrItem(i) > 1 Then
    
21.             sRst = IIf(sRst = "", arrKey(i), sRst & "," & arrKey(i))
    
22.             '[I4] = arrKey(i)
    
23.             'Exit For
    
24.         End If
    
25.     Next
    
26.     [i4] = sRst
    
27. End Sub

复制代码

hwc2ycy

如果只取第一个重复值

1. Sub 重复值提取()
   
2.     Dim sCFMC As String
   
3.     Dim arr
   
4.     Dim dic As Object
   
5.     Dim i As Long
   
6.     Dim arrKey, arrItem
   
7.     Dim sRst As String
   
8.     On Error Resume Next
   
9.     Set dic = CreateObject("scripting.dictionary")
   
10.     arr = Range("a2:b" & [a2].End(xlDown).Row).Value
    
11.     sCFMC = [I2].Value
    
12.     For i = 1 To UBound(arr)
    
13.         If arr(i, 1) = sCFMC Then
    
14.             dic(arr(i, 2)) = dic(arr(i, 2)) + 1
    
15.         End If
    
16.     Next
    
17.     arrKey = dic.Keys
    
18.     arrItem = dic.items
    
19.     For i = 0 To UBound(arrItem)
    
20.         If arrItem(i) > 1 Then
    
21.             'sRst = IIf(sRst = "", arrKey(i), sRst & "," & arrKey(i))
    
22.             [I4] = arrKey(i)
    
23.             Exit For
    
24.         End If
    
25.     Next
    
26.     '[I4] = sRst
    
27. End Sub
    

复制代码

hwc2ycy

重复值提取.rar (10.41 KB, 下载次数: 69)

2012-10-2 11:38 上传

点击文件名下载附件

cyj153

hwc2ycy 发表于 2012-10-2 11:38

谢谢。能否用函数达成！

jlf2003

hwc2ycy 发表于 2012-10-2 11:38

向你学习!这个方法不错.

zhoucs00

1. =IF(COUNTIF(OFFSET($B$1,MATCH($I$2,$A$2:$A$25,),,COUNTIF($A$2:$A$25,$I$2)),OFFSET($B$1,MATCH($I$2,$A$2:$A$25,),,COUNTIF($A$2:$A$25,$I$2)))>1,OFFSET($B$1,MATCH($I$2,$A$2:$A$25,),,COUNTIF($A$2:$A$25,$I$2)),"")

复制代码

试下这个公式，若是有几个重复的也可以。

WANGL2

zhoucs00 发表于 2012-10-2 14:45
试下这个公式，若是有几个重复的也可以。

是数组函数吧？运行结果不正确。请核实，谢谢！

zhoucs00

WANGL2 发表于 2012-10-2 14:53
是数组函数吧？运行结果不正确。请核实，谢谢！

我函数只能做出这样的结果了。看来还是得学VBA……

hwc2ycy

jlf2003 发表于 2012-10-2 14:40
向你学习!这个方法不错.

大家相互学习才是。