有点难度，关于去除“重复”(已解决)

thtfzhaobo

原帖由 zldccmx 于 2009-8-6 15:38 发表


是的，退出EXCEL之后，重新打开EXCEL才有
你返回的结果是　23357
我返回的是　22620

这样说应是你的，我的多，可能有漏
注册是这样，不能再激活状态注册，因为启动时有一次链接

thtfzhaobo

让楼主给一版所有重复的样子，测一下就知道了

Zamyi

原帖由 zldccmx 于 2009-8-6 15:38 发表
不知道到底是多少不重复的数据

原总数目是20638组（以2009-8-6 11:4资料为准），不重复数据应该是2459组。

[ 本帖最后由 Zamyi 于 2009-8-6 16:22 编辑 ]

thtfzhaobo

我的10430？？？

thtfzhaobo

老朽用我的测试2万多？？？？？？楼主测试呢？重新锁定一个附件吧，我看看到底多少

[ 本帖最后由 thtfzhaobo 于 2009-8-6 16:06 编辑 ]

zldccmx

是呀
我用的是原始附件，3W多条的数据

thtfzhaobo

重新下载了1楼附件，8秒多，形成2351条结果，大家测试，请通报

thtfzhaobo

原始附件，重新生成数据，测试近28秒，结果10430条结果

xyh_bear

用以下代码测试你那38340行数据，只需要140秒左右，可以说算最快的了。
楼主再要嫌慢，那就没办法了。

附件为： Test.rar (178.1 KB, 下载次数: 14)

2009-8-6 17:04 上传

点击文件名下载附件

具体实现思路如下：

利用 Dictionary 字典，主键唯一性。

1、逆向逐行对每行12个单元格的值进行排序，并组合成一字符串，
2、再检查字典中是否存在该字符串为主键的键值；
3、如果第二步存在的话，将删除该行。不存在则在字典中添加一主键，其键值为第一步组合成的字符串

以下代码，按楼主提供的数据38340行12列，将循环次为38340*12次，共有8513组数为不重复的

1. Sub 行与行的值全部相同则只保留一行()
   
2.     Dim nRowCount As Long
   
3.     Dim DR As Dictionary
   
4.     Dim DelLine As String, TT As String
   
5.    
   
6.     yy = Timer
   
7.     bStop = False
   
8.     nRowCount = Sheet1.Range("a1").CurrentRegion.Rows.Count       '获得数据行数
   
9.    
   
10.     Set DR = New Dictionary    '建立一新空白字典对象
    
11.    
    
12.     For i = nRowCount To 1 Step -1    '逆向逐行检查
    
13.         TT = ""
    
14.         
    
15.         For J = 1 To 12   '对每行12个数进行排序
    
16.             '对行进行排序
    
17.             
    
18.             DoEvents    '移交控制权，以免程序运行时，鼠标无法点击工作表中“停止”按钮
    
19.             
    
20.             If bStop = True Then Exit Sub    '如果点了停止按钮，则中断程序
    
21.             
    
22.             TT = TT & "/" & Application.WorksheetFunction.Small(Sheet1.Range(Sheet1.Cells(i, 1), Sheet1.Cells(i, 12)), J)      '获得该行12个数排序后得到的字符串，并付值给变量TT
    
23.         Next
    
24.         
    
25.         Application.StatusBar = "正在检测 第 " & i & " 行， 最终检查到 1 时就结束程序，请耐心等候。。。（己完成 " & Format(i / nRowCount, "0.0%") & "）" '状态栏提示动态文字。
    
26.         
    
27.         If DR.Exists("k" & TT) = True Then    '如果以 TT 字符串为主键的键存在于字典时，则删除该行
    
28.             If Len(DelLine & "," & i & ":" & i) > 256 Or i = 1 Then  '行号字符满256或检测到最后一行时将删除重复的行
    
29.                 If Len(DelLine) <> 0 Then
    
30.                     DelLine = Right(DelLine, Len(DelLine) - 1)
    
31.                     Range(DelLine).Delete Shift:=xlUp
    
32.                     DelLine = "," & i & ":" & i
    
33.                 Else
    
34.                     Range("1:1").Delete Shift:=xlUp
    
35.                 End If
    
36.             Else
    
37.                 DelLine = DelLine & "," & i & ":" & i
    
38.             End If
    
39.         Else
    
40.             DR.Add "k" & TT, "k" & TT     '如果以 TT 字符串为主键的键不存在于字典时，则添加主键 TT
    
41.         End If
    
42.     Next
    
43.    
    
44.     Application.StatusBar = False  ' 循环完成后，将状态栏文字恢复到默认。
    
45.    
    
46.     MsgBox DR.Count & "用时：" & Timer - yy
    
47. End Sub

复制代码

[ 本帖最后由 xyh_bear 于 2009-8-6 17:04 编辑 ]

thtfzhaobo

楼主给个标准吧，大家无法验证代码，那等于所有都是废的