用VBA删除内容相同而排列不同的重复项

amulee

例如
      “电脑 手机”  “手机 电脑”

这种内容相同  只是排列不同的怎么能筛选出来呢？
或者更难一些   “电脑 手机 鼠标” “手机 鼠标 电脑”
等等 内容相同但是排列不同的怎么删除呢

利用字典，可以先将字符串转化为数组，排序后再转化为字符串，再用字典去重复。

代码如下：

1. Sub 去重复()
   
2.     Dim ArrYS, ArrJG, ArrTemp
   
3.     Dim i&, Temp
   
4.     Dim d1 As Object
   
5.     Dim d2 As Object
   
6.     '创建字典对象
   
7.     Set d1 = CreateObject("Scripting.Dictionary")
   
8.     Set d2 = CreateObject("Scripting.Dictionary")
   
9.     '原始数组
   
10.     ArrYS = Range("A1:A8")
    
11.     '遍历原始数组
    
12.     For i = 1 To UBound(ArrYS)
    
13.         ArrTemp = Split(ArrYS(i, 1), " ") '将各内容转化为数组
    
14.         If UBound(ArrTemp) > 0 Then '排序
    
15.             Call ArrSort(ArrTemp)   '数组排序
    
16.         End If
    
17.         '排序后再转为字符串，再利用字典判断
    
18.         Temp = Join(ArrTemp)
    
19.         If Not d1.exists(Temp) Then
    
20.             d1(Temp) = 1
    
21.             d2(ArrYS(i, 1)) = 1
    
22.         End If
    
23.     Next i
    
24.     '输出结果
    
25.     Range("C1").Resize(d2.Count, 1) = WorksheetFunction.Transpose(d2.keys)
    
26. End Sub
    
27. Sub ArrSort(ByRef ArrYS)    '数组排序
    
28.     Dim i&, j&
    
29.     Dim Temp
    
30.     For i = LBound(ArrYS) To UBound(ArrYS) - 1
    
31.         For j = i + 1 To UBound(ArrYS)
    
32.             If ArrYS(i) > ArrYS(j) Then
    
33.                 Temp = ArrYS(i)
    
34.                 ArrYS(i) = ArrYS(j)
    
35.                 ArrYS(j) = Temp
    
36.             End If
    
37.         Next j
    
38.     Next i
    
39. End Sub
    

复制代码

附件下载： 删除排列不同的重复项.rar (12.81 KB, 下载次数: 52)

2011-1-19 08:35 上传

点击文件名下载附件

轩辕轼轲

{:912:}不错

西安专家

好办法{:35:}

raulerini

学习。{:3112:}

vbaxinshou