超难，如何用最快的速度查出15项相同的数据记录！

香川群子

楼主2010-12-14的求助帖……附件都是一样的啦。

http://club.excelhome.net/thread-661171-1-1.html

lj1226189

是的因为对速度还不太满意，所以重新发出来了！论坛里高手如云，相信我的愿望能够实现！

lee1892

lj1226189 发表于 2013-4-25 15:32
有朋友能在30秒内解决，但就是不肯给我看结果！做梦都想知道如何能在30秒内实现！

哈哈，貌似我的机器上是2秒

看我的数据结构帖子吧，你要是碰到的数据是真实数据会更快。

双循环对比的方法弱爆了，嘿嘿~~
本贴后面有更快的哦~~向后翻~~

lj1226189

楼上能否拿出来给我看看！真是不可思议！

lee1892

lj1226189 发表于 2013-4-25 15:39
楼上能否拿出来给我看看！真是不可思议！

哎，还要帮你贴链接：
http://club.excelhome.net/forum. ... 920&pid=6851711

香川群子

yangyangzhifeng 发表于 2013-4-25 12:34
略微提速

下面算法
【字典转换序号定位数组比对】方法速度比你快3倍。

1. Sub kagawa()
   
2.    
   
3.     Dim i&, j&, k&, m&, n&, r&, s$, t, cnt&, tms#
   
4.     tms = Timer
   
5.    
   
6.     arr = Sheet1.[a1].CurrentRegion
   
7.     m = UBound(arr): n = UBound(arr, 2)
   
8.    
   
9.     ReDim brr&(2 To m, 2 To n)
   
10.     Set d = CreateObject("Scripting.Dictionary")
    
11.     For j = 2 To n
    
12.         For i = 2 To m
    
13.             t = d(CStr(arr(i, j)))
    
14.             If t = "" Then k = k + 1: d(CStr(arr(i, j))) = k: t = k
    
15.             brr(i, j) = t
    
16.         Next
    
17.         d.RemoveAll
    
18.     Next
    
19.     Set d = Nothing
    
20.    
    
21.     ReDim crr$(m, 1)
    
22.     For i = 2 To m
    
23.         For k = i + 1 To m
    
24.             cnt = 0
    
25.             For j = 2 To n
    
26.                 If brr(i, j) - brr(k, j) Then cnt = cnt + 1: If cnt > 4 Then Exit For
    
27.             Next
    
28.             If cnt < 5 Then s = s & " " & k - 1 & "(" & 19 - cnt & ")"
    
29.         Next
    
30.         If Len(s) Then crr(r, 0) = i - 1: crr(r, 1) = s: s = "": r = r + 1
    
31.     Next
    
32.    
    
33.     Sheet2.[a1].CurrentRegion.Offset(1) = ""
    
34.     Sheet2.[a2].Resize(r, 2) = crr
    
35.    
    
36.     MsgBox Format(Timer - tms, "0.000s ") & "kagawa"
    
37. End Sub
    

复制代码

香川群子

上述字典整理序号位置，然后进行数组比对的算法，是【lee1892】首先在楼主http://club.excelhome.net/thread-661171-1-1.html求助帖中用代码实现的。

我的代码算法一样，但具体代码写法稍有不同。
尤其是在前面字典部分，我只用了一个字典。

lj1226189

惊天地，泣鬼神！

lee1892

lj1226189 发表于 2013-4-25 15:39
楼上能否拿出来给我看看！真是不可思议！

觉得爽了的，你要使劲给花哈，我可写了老多行代码了~~

lj1226189

lee1892 发表于 2013-4-25 15:57
觉得爽了的，你要使劲给花哈，我可写了老多行代码了~~

楼上老师绝顶高手！我等自吧不如啊！