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

Zamyi

我的方法大概要23-24分钟：
Option Base 1
Sub Macro1()
t = Timer
Dim R, R1, Rt(), dic As New Dictionary
With Sheets("数据")
n = .[l65536].End(3).Row
R = .Range("a1:l" & n)
ReDim Rt(n, 12)
For i = 1 To n
R1 = Application.Index(R, i, 0)
If Not IsCF(R1, dic) Then
  dic(R1(1) & " " & R1(2) & " " & R1(3) & " " & R1(4) & " " & R1(5) & " " & R1(6) & " " & R1(7) & " " & R1(8) _
  & " " & R1(9) & " " & R1(10) & " " & R1(11) & " " & R1(12)) = ""
  End If
  Application.StatusBar = "正在检测..." & "已经检测第:" & i & "行。"
  DoEvents
Next
.[n1].Resize(dic.Count) = Application.Transpose(dic.Keys)
End With
MsgBox Timer - t
Set D = Nothing
End Sub
Public Function IsCF(R, D As Dictionary) As Boolean
IsCF = False
If D.Exists(R(1) & " " & R(2) & " " & R(3) & " " & R(4) & " " & R(5) & " " & R(6) & " " & R(7) & " " & R(8) _
  & " " & R(9) & " " & R(10) & " " & R(11) & " " & R(12)) Then IsCF = True: Exit Function
If D.Exists(R(3) & " " & R(4) & " " & R(5) & " " & R(6) & " " & R(7) & " " & R(8) & " " & R(9) & " " & R(10) _
  & " " & R(11) & " " & R(12) & " " & R(1) & " " & R(2)) Then IsCF = True: Exit Function
If D.Exists(R(5) & " " & R(6) & " " & R(7) & " " & R(8) & " " & R(9) & " " & R(10) & " " & R(11) & " " & R(12) _
  & " " & R(1) & " " & R(2) & " " & R(3) & " " & R(4)) Then IsCF = True: Exit Function
If D.Exists(R(7) & " " & R(8) & " " & R(9) & " " & R(10) & " " & R(11) & " " & R(12) & " " & R(1) & " " & R(2) _
  & " " & R(3) & " " & R(4) & " " & R(5) & " " & R(6)) Then IsCF = True: Exit Function
If D.Exists(R(9) & " " & R(10) & " " & R(11) & " " & R(12) & " " & R(1) & " " & R(2) & " " & R(3) & " " & R(4) _
  & " " & R(5) & " " & R(6) & " " & R(7) & " " & R(8)) Then IsCF = True: Exit Function
If D.Exists(R(11) & " " & R(12) & " " & R(1) & " " & R(2) & " " & R(3) & " " & R(4) & " " & R(5) & " " & R(6) _
  & " " & R(7) & " " & R(8) & " " & R(9) & " " & R(10)) Then IsCF = True: Exit Function

If D.Exists(R(1) & " " & R(12) & " " & R(11) & " " & R(10) & " " & R(9) & " " & R(8) & " " & R(7) & " " & R(6) _
& " " & R(5) & " " & R(4) & " " & R(3) & " " & R(2)) Then IsCF = True: Exit Function
If D.Exists(R(11) & " " & R(10) & " " & R(9) & " " & R(8) & " " & R(7) & " " & R(6) & " " & R(5) & " " & R(4) _
& " " & R(3) & " " & R(2) & " " & R(1) & " " & R(12)) Then IsCF = True: Exit Function
If D.Exists(R(9) & " " & R(8) & " " & R(7) & " " & R(6) & " " & R(5) & " " & R(4) & " " & R(3) & " " & R(2) _
& " " & R(1) & " " & R(12) & " " & R(11) & " " & R(10)) Then IsCF = True: Exit Function
If D.Exists(R(7) & " " & R(6) & " " & R(5) & " " & R(4) & " " & R(3) & " " & R(2) & " " & R(1) & " " & R(12) _
& " " & R(11) & " " & R(10) & " " & R(9) & " " & R(8)) Then IsCF = True: Exit Function
If D.Exists(R(5) & " " & R(4) & " " & R(3) & " " & R(2) & " " & R(1) & " " & R(12) & " " & R(11) & " " & R(10) _
& " " & R(9) & " " & R(8) & " " & R(7) & " " & R(6)) Then IsCF = True: Exit Function
If D.Exists(R(3) & " " & R(2) & " " & R(1) & " " & R(12) & " " & R(11) & " " & R(10) & " " & R(9) & " " & R(8) _
& " " & R(7) & " " & R(6) & " " & R(5) & " " & R(4)) Then IsCF = True: Exit Function
End Function

thtfzhaobo

dll注册使用，请测试

thtfzhaobo

我的方法要30秒左右，不知结果如何，用12行的例子测试正常。
没去作进一步优化，没想出节省大量时间的方式，少量加快还是可以，但太少了

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

thtfzhaobo

修正获取对象的一个小错误，防止变量丢失，12列确实花时间，如果6列几秒就可以

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

Zamyi

原帖由 thtfzhaobo 于 2009-8-6 13:59 发表
修正获取对象的一个小错误，防止变量丢失，12列确实花时间，如果6列几秒就可以

如何使用呢？

thtfzhaobo

更新附件，先解压，关闭excell，运行“注册UserFunction.bat”
不用注销
启动excel会出现工具栏，office07在加载项里，“去除重复”
打开所需文件，将数据表置为当前
运行后，提示“数据开始行”及“数据列数”
默认是你附件的条件，可依据实际情况改变

thtfzhaobo

过程可参考

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

Zamyi

原帖由 thtfzhaobo 于 2009-8-6 14:32 发表
更新附件，先解压，关闭excell，运行“注册UserFunction.bat”
不用注销
启动excel会出现工具栏，office07在加载项里，“去除重复”
打开所需文件，将数据表置为当前
运行后，提示“数据开始行”及“数据列数”
...

谢谢，不错不错！快的不得了！能给源码么？

thtfzhaobo

我看了你写的代码，其实真的差不多，只是我所有数据传递过程都是用数组作，你在优化一下，效果同

zldccmx

我的代码与你运行的结果不一样，我返回的结果是22620条记录