ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
楼主: lj1226189

[求助] 超难,如何用最快的速度查出15项相同的数据记录!

  [复制链接]

TA的精华主题

TA的得分主题

发表于 2013-5-2 13:23 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
lee1892 发表于 2013-4-25 22:02
我很期待~

36楼改进版附件无法下载,请重新上传。谢谢!

TA的精华主题

TA的得分主题

发表于 2013-5-2 13:31 | 显示全部楼层
本帖最后由 lee1892 于 2013-5-2 13:35 编辑
香川群子 发表于 2013-5-2 12:55
楼主提供的9586行数据,应该是比较符合实际的数据了。

不管怎么说,我的代码,比全循环比对还是快了不 ...

首先,我还是希望你能够将自己实现方式的逻辑表达清楚,否则别人很难从你的代码里得到什么。像这样的一个例子里,思路(其实就是算法的实质)远比代码本身重要的多。

其次,我所说的实际是针对楼主的需求而言的。楼主所做的事情是在检查数据是真实的测量数据还是人工编造的。而对于水质监测的数据而言,真实的测量数据应该是十分分散的,也就是说除了同一水源水样外,水质指标数值完全一致或多个一致的可能性微乎其微。那么楼主的需要仅仅是有足够理由判定数据是伪造的就可以了,不太会需要改变是15个还是11个项目。而同时,如果是真实的测量数据(应该是可能性较大才对),那么采用我提供的方法会非常快的(不知道你的实现方法是否也是如此)。

另外,考量一种实现方式的好坏,犹为重要的是其功能扩展的难易程度。结合此例,对于水质指标而言,显然对指标值相近的进行分级、分类是常用的手段。那么,我所提供的实现方式和代码结构就会很容易的加以改造实现。

至于变量名的使用习惯,我坚持我的看法,你所采用的简单字母组合的方式是最不可取的。这与水平高低无关。

以上,供参考~
36楼改进版附件无法下载,请重新上传。谢谢!
自测没问题。

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2013-5-2 15:18 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
lee1892 发表于 2013-5-2 13:31
首先,我还是希望你能够将自己实现方式的逻辑表达清楚,否则别人很难从你的代码里得到什么。像这样的一个 ...

我的算法,原始数据差异性越大表现越好。

反之,如果原始数据差异性很小则表现较差。
(如:【臭和味】以及【肉眼可见物】的指标结果只是0、1判断时)
但如果这样差异性小的数据只是个别性的而不是所有19列都这样,
则可以认为完全没有影响。

即,对于15列相同的检查要求,实际只要比对前5列即可,
也就是说,只要前5列有足够的差异性就不会影响速度。


TA的精华主题

TA的得分主题

发表于 2013-5-2 15:57 | 显示全部楼层
本帖最后由 香川群子 于 2013-5-2 19:42 编辑
lee1892 发表于 2013-5-2 13:31
首先,我还是希望你能够将自己实现方式的逻辑表达清楚,否则别人很难从你的代码里得到什么。像这样的一个 ...


36楼改进版附件无法下载,请重新上传。谢谢!

【自测没问题。】


…………
我这里的问题是:
看到有一个附件的图标,但鼠标靠近后无法出现右键选项。
因此无法进行下载、保存附件的操作。

Picture 1.jpg

现在已经可以下载附件了。可能刚才单位里的电脑有问题。

TA的精华主题

TA的得分主题

发表于 2013-5-2 16:03 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
这题似乎可以换个角度来解决:
1、从19个项目中抽取15个进行组合
2、根据每个组合对相关的单元格进行合并
3、用组合的字符串做为字典的key
4、判断字典的item是否>2

不知道这个思路行不行,{:soso_e100:}

TA的精华主题

TA的得分主题

发表于 2013-5-2 16:26 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
lee1892 发表于 2013-5-2 13:31
首先,我还是希望你能够将自己实现方式的逻辑表达清楚,否则别人很难从你的代码里得到什么。像这样的一个 ...

【对于水质监测的数据而言,真实的测量数据应该是十分分散的,也就是说除了同一水源水样外,水质指标数值完全一致或多个一致的可能性微乎其微。】


如果真实数据会更加分散的话,我认为我的算法速度上会比你的更快。

我的明确思路如下:
1. 仅检查差异性最大的前n列。(n=19-15+1=5列)
2. 每列仅检查和本行数值相同的行。(不相同的行不用检查)
3. 全部5列中,只要任意一列的数值有相同的都要检查。
  因此检查完成后,剩余的其它各行,就一定是所有5列都没有一个数值和本行相同的了。
  那么,即使这以后余下的14列全部都和本行相同,也不会满足相同项目=15的要求了。


具体算法实现的要点,是用嵌套数组来储存、获取前n列中和本行具有相同的值的所有行位置。

所以本质上确实是很简单的思路。


TA的精华主题

TA的得分主题

发表于 2013-5-2 16:41 | 显示全部楼层
香川群子 发表于 2013-5-2 16:26
【对于水质监测的数据而言,真实的测量数据应该是十分分散的,也就是说除了同一水源水样外,水质指标数值 ...

我理解你的这个想法,我也是这样么想的,只是没有具体实现!

TA的精华主题

TA的得分主题

发表于 2013-5-2 16:49 | 显示全部楼层
具体代码的解释:

第1阶段,获取原始数据:
arr = Sheet1.[a1].CurrentRegion '原始数据读入数组arr
m = UBound(arr) '数据最大行数m  (第1行为标题行)
n = UBound(arr, 2) '数据最大列数n (第1列为序号列)
nn = n - nn + 1 '确定需要检查的列数 (即 nn=总列数-相同列数+1)
'由于数据的行、列都是从2开始,所以以后所有行列数值都比实际的要大1


第2阶段,用字典整理原始数据为长整形,以便快速计算:

   ReDim brr&(-1 To m, 2 To n) '定义数组brr用来存放整理后的长整型数据
   '行数扩展增加3行用来储存中间结果。所以从-1开始。(增加了 -1,0,1 共3行,以及实际数据行 2 to m)
   '列数和实际数据列保持一致(2 to n)
    Set d = CreateObject("Scripting.Dictionary") '设置一个字典d,循环使用2 to n次即可。
    For j = 2 To n '循环遍历各列
        ReDim crr(m) '定义临时数组crr,用来统计存放本列每个字典关键词的对应行的个数
     '我这样做,可以省去使用另一个字典,并提高速度(数组比字典更快!)
        For i = 2 To m '遍历检查本列中各行
            t = d(CStr(arr(i, j))) '检查对应行列交叉位置的数值是否已在字典内
            If t = "" Then k = k + 1: d(CStr(arr(i, j))) = k: t = k '如果不在字典内则字典新增k+1
            brr(i, j) = t '该行列交叉位置值根据字典转为长整型便于计算比对
            crr(t) = crr(t) + 1 '本字典值对应个数统计+1
        Next
        d.RemoveAll '本列全部遍历后,字典清空,以便下一列使用。
        brr(1, j) = k 'brr数组第1行存入该列字典关键字个数k
        For i = 1 To k '遍历k以便计算本列全部比对时需要的计算次数。
            brr(-1, j) = brr(-1, j) + crr(i) * (crr(i) + 1) / 2 '根据Σ=1 to 各字典项对应行总数来计算。
        ' brr(-1, j)相当于你代码中的.CmpCount
            ' crr(i)相当于你代码中的 Indexes(k).RowCount   
        Next
        k = 0 'k值初始化清零
    Next
    Set d = Nothing '全部整理完成后字典就不需要了。(这以后我都是通过数组完成计算,没有再用字典)
    ss = "Dic Process:   " & Format(Timer - tms, "0.000s"): tms = Timer
   
待续……

TA的精华主题

TA的得分主题

发表于 2013-5-2 17:00 | 显示全部楼层
第3阶段排序,确定需要检查的前nn列是哪几列。

    brr(0, 2) = 2 'brr数组中0行作为排列列序号位置 相当于你的arrPrmtIndSort()的作用
   '下面排序工作不解释了。我用的是比较落后的插值排序,没有用冒泡交换排序。
   '反正对整体速度影响不大。
    For i = 3 To n
        r = brr(-1, i)
        l = brr(1, i)
        For j = 2 To i - 1
            If r < brr(-1, j) Then
                For k = i To j + 1 Step -1
                    brr(-1, k) = brr(-1, k - 1)
                    brr(0, k) = brr(0, k - 1)
                    brr(1, k) = brr(1, k - 1)
                Next
                Exit For
            End If
        Next
        brr(-1, j) = r
        brr(0, j) = i
        brr(1, j) = l
    Next
    ss = ss & vbCr & "Sort:          " & Format(Timer - tms, "0.000s"): tms = Timer
   
'最后,
在brr数组的第-1行,是计算比对次数。
在brr数组的第 0行,是根据计算比对次数从小到大排序的列序号。(范围2 to n)
所以结果就是: 9,8,5,12,16,13,4,19,17,3,6,14,7,15,2,18,20,11,10
对应你的arrPrmtIndSort()的作用,但数值要大1 (你是1 to nItemNum)
在brr数组的第1行,是整个列的字典项关键词个数k

呵呵。
待续……

TA的精华主题

TA的得分主题

发表于 2013-5-2 17:16 | 显示全部楼层
接下来,才是我的算法的关键部分:

用嵌套数组来存放、获取每一行对应列中有相同值的所有行。

ReDim crr(2 To nn) '定义数组crr 用来存放前nn列对应的各种行信息(最后结果是一个嵌套数组)
    For l = 2 To nn '遍历前nn列
        j = brr(0, l) '根据排序结果转换为实际列位置j
        r = brr(1, l) '获取该列对应字典项目总数k
        ReDim x(1 To r) '每次重新定义数组x以便存放对应各个字典关键词的所有行位置信息
        For i = 2 To m '遍历该列所有行
            x(brr(i, j)) = x(brr(i, j)) & " " & i '对应数组x中汇总行位置信息
        Next
        '遍历各行整理完以后,在进行数组处理,存入crr嵌套数组
        For k = 1 To r '遍历各字典关键词
            y = Split(x(k)) '把汇总在x中的行信息字符串转换为一维数组y
            y(0) = UBound(y) '该一维数组y第一个0位置写入该x数组总个数(即具有相同值的行的总个数)
            x(k) = y '把这个整理好的一维数组y写回到x数组中形成嵌套数组x
        Next
        crr(l) = x '在crr中写入本列对应的嵌套数组x,使得crr成为一个二层嵌套数组
    Next
    ss = ss & vbCr & "Filter:        " & Format(Timer - tms, "0.000s"): tms = Timer
   

整理完成

待续。下面就是逐行检查比对了。

您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-11-15 07:24 , Processed in 0.045655 second(s), 8 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表