[已解决]求用函数剔除重复项

李建军

一朋友一题，挺实际的，一直弄不出来想学习下，如附件，！  谢all~~~不是学习资料是求助贴..{:021:}


另外求论坛一位大神的名言，挺受益的。大概说的：只要.....,高手是迟早的事。

最佳答案

月排行榜 / 总排行榜

qh8600

2014-10-14 12:08

李建军 发表于 2014-10-14 11:47
PS:不借助辅助列~~各位辛苦了

函数弄感觉好难

跳转到最佳答案楼层

李建军

PS:不借助辅助列~~各位辛苦了

qh8600

李建军 发表于 2014-10-14 11:47
PS:不借助辅助列~~各位辛苦了

函数弄感觉好难

李建军

qh8600 发表于 2014-10-14 12:08
函数弄感觉好难

那能来个vba  感受下！{:011:} 感谢！！！

Excel学徒123

李建军 发表于 2014-10-14 12:13
那能来个vba  感受下！ 感谢！！！

{:1212:}

李建军

Excel学徒123 发表于 2014-10-14 12:36

被发现了......{:171:}

qh8600

李建军 发表于 2014-10-14 12:13
那能来个vba  感受下！ 感谢！！！

1. Sub demo()
   
2.     Dim arr, re(), m As String, str As String
   
3.     m = Range("j2")
   
4.     arr = Sheets("备用").Range("a2:g" & Sheets("备用").Cells(Rows.Count, 1).End(xlUp).Row)
   
5.     Set d = CreateObject("Scripting.Dictionary")
   
6.     ReDim re(1 To UBound(arr), 1 To 6)
   
7.     For i = 1 To UBound(arr)
   
8.         If arr(i, 2) = m Then
   
9.             str = arr(i, 4) & "|" & arr(i, 5)
   
10.             If Not d.Exists(str) Then
    
11.                 Cnt = Cnt + 1
    
12.                 d(str) = Cnt
    
13.                 For j = 1 To 6
    
14.                     re(Cnt, j) = arr(i, j)
    
15.                 Next j
    
16.             End If
    
17.         End If
    
18.     Next i
    
19.     Sheets("备用").Range("j3").Resize(Cnt, 6) = re
    
20. End Sub
    

复制代码

Excel学徒123

qh8600 发表于 2014-10-14 12:44

86大师威武~~~

这儿有肥猫

去除重复项？论坛随便搜一下就有方法吧~

李建军

Excel学徒123 发表于 2014-10-14 12:36

函数的也粗来了  {:101:}