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

香川群子

解释后补：

ReDim drr$(m, 1) '定义存放结果的数组drr
    For i = 2 To m - 1 '遍历比对2 to m-1 (最后一行不需要检查了)
        For l = 2 To nn '遍历最初的nn行 即 总列数-相同列数+1 =20-15+1=6
            '(实际为5行，因为我的实际列数是从第2列开始到第6列)
            r = brr(i, brr(0, l)) 'brr(0, l)为按从小到大排序的对应实际列位置，brr(i, brr(0, l))就是对应实际的行、列交叉位置值(字典关键词)
            For k = 1 To crr(l)(r)(0) '遍历嵌套数组中对应关键词相同的所有行元素
                      'crr(l)为嵌套数组中对应本列，crr(l)(r)为嵌套数组中对应该字典关键词r的对应一维数组x，该数值的(0)元素就是对应数组x的元素个数。
                      '因此crr(l)(r)(0)就是  与被检查的行、列交叉位置对应数值完全相同的所有行的个数。也可以写作ubound(crr(l)(r))
                ii = crr(l)(r)(k) '同样的，ii=crr(l)(r)(k) 表示取得遍历嵌套数组中的每一个行位置
                If ii > i Then '如果该行位置比当前行大就继续，否则退出(因为嵌套数组x中包括所有行位置，需要排除)
                    If InStr(s, " " & ii - 1 & "(") = 0 Then '进一步检查该行位置是否已经被检查为相同个数符合条件而取出，避免重复。
                        '我是在这里就进行排除重复的，而Lee1892改进前的代码是所有计算完成后再进行比较排除。这个是有算法差异的地方。
                        cnt = cnt + 1 '统计比对次数
                        cc = 1 '比对相同列数初始化(我的所有列数都是以1为0处理的。这是为了和原始数据的列位置保持一致。）
                        For jj = 2 To n '遍历检查各列
'                            If brr(ii, jj) - brr(i, jj) Then cc = cc + 1 '数值不同时计数+1
                            If cc = nn Then Exit For 计数值达到界限值(=6)时退出检查
                        Next
                        If cc < nn Then s = s & " " & ii - 1 & "(" & n - cc & ")" '如果检查计数值没超过界限值则符合列数条件可以输出结果
                    End If
                End If
            Next
        Next
        If Len(s) Then drr(kk, 0) = i - 1: drr(kk, 1) = s: s = "": kk = kk + 1 '如果检查结果有满足列数条件的则把结果写入数组drr
'         Application.StatusBar = i & " /Cnt: " & cnt & " /Result: " & kk
    Next
    ss = ss & vbCr & "Compare Check: " & Format(Timer - tms, "0.000s"): tms = Timer
   

最后是输出结果到工作表，以及返回各种信息。

'    Sheet2.[a1].CurrentRegion.Offset(1) = ""
'    Sheet2.[a2].Resize(kk, 2) = drr
'
'    ss = ss & vbCr & "Output:        " & Format(Timer - tms, "0.000s") & vbCr
    ss = ss & vbCr & "Time Total:    " & Format(Timer - tts, "0.000s") & vbCr
    ss = ss & vbCr & "Compare same >= " & n - nn + 1
    ss = ss & vbCr & "Get: " & kk & " / " & cnt & " cnt" & vbCr
    MsgBox ss & vbCr & " - by kagawa -"
   
End Sub

香川群子

lee1892 发表于 2013-5-2 10:36
在我之前的代码上进行了如下改进，附件：：
1、增加了一个arrCompared布尔型数组，二维，直接用数据行行 ...

优化效果明显，值的学习。

香川群子

理论上讲，我的算法也还有很大改进余地以避免重复检查。

不过，由于嵌套数组本身是Variant变量，所以和使用Long变量数组相比较，速度就已经差很多了……

香川群子

嵌套数组处理过程中改用如下代码，即把嵌套中最后一层的数组定义为Long数组，结果计算速度大约提高30%倍，整个代码提速15-20%
这样一来，我的算法已经全面超过Lee1892改进前的算法速度了。

       For k = 1 To r
            y = Split(x(k))
            cc = UBound(y)
            ReDim z&(cc) '此处多用一个Long数组z
            z(0) = cc
            For ii = 1 To cc
                z(ii) = y(ii)
            Next
            x(k) = z '原来用Variant变量数组y的地方，改为使用Long变量数组z → 仅此一个优化提高了很多速度。
        Next

lee1892

香川群子 发表于 2013-5-2 17:00
第3阶段排序，确定需要检查的前nn列是哪几列。

    brr(0, 2) = 2 'brr数组中0行作为排列列序号位置 相当 ...

刚看完斯诺克～

我算看明白了，这不一回事吗，任选5个至少1个相同，用这个原则进行筛选。
和你之前说的完全不是一样啊。

不过数据没有经过逻辑性很强的整理，写这样的代码估计蛮耗细胞的～

很好，继续想办法提高速度，并尝试用概括性的语言描述思路。

香川群子

lee1892 发表于 2013-5-2 23:07
刚看完斯诺克～

我算看明白了，这不一回事吗，任选5个至少1个相同，用这个原则进行筛选。

参考你的boolean 检查方法，我也对自己的算法进行了优化。
（其实之前我也有检查，但是是用了instr方法只检查已经提取结果的部分，不够完整。）

另外，我的嵌套数组由Variant 改为Long数组了，这也提高了20%左右。

最后的效果很不错，综合效果已经比你的代码速度更快了……

香川群子

上附件。


和你的算法比，我的检查次数还是比较多。
但你需要对提取结果作整理，而这一项工作在结果量大时非常耗费时间。

香川群子

我的boolean数组是这样使用的，比你的效率高多了：

For i = 2 To m - 1 '循环检查 2 to m -1 时使用
    ReDim frr(i To m) As Boolean 仅定义 i to m 的一维数组，这样可以节省内存空间
    For l = 2 To nn '然后开始对该 i 行的 2 to nn 各列检查。

呵呵

香川群子

lee1892 发表于 2013-5-2 23:07
刚看完斯诺克～

我算看明白了，这不一回事吗，任选5个至少1个相同，用这个原则进行筛选。

虽然算法思路基本上是一回事，但实现的代码算法差别还是不小……

香川群子

改进第3版。 接近极限啦。

我的算法，尤其在需要对比的列数增加时效果显著。


……
Lee1892的改进第2项：
2、在对第5个项目（按所需对比次数升序）检查时，
   如果是未对比过的两行（说明前4个项目不同），
   则检查第6个项目是否相同，否则直接排除

结论是，我的代码可以轻易地做到，并且是这样的效果：
检查第1列时，第1列相同，还没有任何不同的列，因此从余下第2列开始比较，需要比对至少其余有 5列不同
检查第2列时，第2列相同，但第1列已经是不同的了，因此从余下第3列开始比较，只需要比对至少其余有 4列不同即可
检查第3列时，第3列相同，但第1-2列已有2列不同，因此从余下第4列开始比较，只需要比对至少其余有 3列不同即可
检查第4列时，第4列相同，但第1-3列已有3列不同，因此从余下第5列开始比较，只需要比对至少其余有 2列不同即可
检查第5列时，第5列相同，但第1-4列已有4列不同，因此从余下第6列开始比较，只需要比对至少其余有 1列不同即可

比对部分代码是：
         ii = krr(l).Index(r).RowNums(k) '确定待检查行位置
         If ii > i Then '如果待检查行位置大于本行则继续，否则不需要检查
                    If frr(ii) = False Then '如果历史记录为False未检查过则继续，否则不需要重复检查
                        frr(ii) = True  '检查历史记录更新为True
                        cc = l '检查计数器初始化【注意不是从0开始，而是从当前列序号开始】
                        For j = l + 1 To n '从本列的下一列开始检查（列序按从小到大）
                            jj = brr(0, j) '从小到大的列序号转换为数据表中对应实际的列位置
                            If brr(ii, jj) - brr(i, jj) Then cc = cc + 1 '如不同则检查计数器+1
                            If cc > nn Then Exit For '检查计数器>检查目标列数时提前退出
                        Next
                        If cc <= nn Then s = s & " " & ii - 1 & "(" & n - cc + 1 & ")"
                         '不同列数未达到检查目标列数时则该列为相同列可以提取结果了
                    End If
                End If

这样处理以后，比较次数才是最少的。

即，不仅仅针对检查最后1列做优化，而是所有的检查列都做优化处理了。