紧急求助高手，如何解决这个水样监测统计，字典法可能最好！

office2008

原帖由 northwolves 于 2010-12-15 09:17 发表

Sub Test()
Dim arr, brr, t$, i&, j&, k&, l&, m&, n&, tt!
arr = [a1].CurrentRegion
ReDim brr(UBound(arr), 1)
tt = Timer
brr(0, 0) = "监测点编号"
brr(0, 1) = "相似监测点"
For k = 2 To UBound(ar ...

学习了，狼大师的代码

这个例子其实蛮实用的，比如用在监测方面，用于多少多少指标相同表示某事件的共性 等等。

江左

刚才1万行运行20分钟没结束，100行测试的运行了8秒

Sub 水样检测()

'19个指标中，要求15个以上（含）相同

Dim i1row As Integer, i2colume As Integer, counter As Integer

For i1row = 2 To 100 '实际有10000
   
    For i3row = 1 To 99 '比i1row小1，候选行递进
        
        counter = 0
   
        For i2colume = 2 To 20 '两行比较
            If Worksheets("sheet1").Cells(i1row, i2colume) = Worksheets("sheet1").Cells(i1row + i3row, i2colume) Then
            counter = counter + 1
            End If
        Next i2colume
        
        If counter >= 15 Then
        Worksheets("sheet2").Cells(i1row, 2) = Worksheets("sheet1").Cells(i1row + i3row, 1)
        Worksheets("sheet2").Cells(i1row, 3) = counter
        End If

    Next i3row

Next i1row

End Sub

江左

监测点编号        指标吻合检测点        吻合程度
1        2        19
2               
3        4        19
4               
5        6        19
6               
7        8        19
8               
9        10        19
10               
11        12        19
12               
13        14        19
14               
15        16        19
16               
17        18        19
18               
19               
20               
21               
22               
23               
24               
25

lj1226189

运行了一下，发现部部份19的水样指标不完全相同！烦请狼版帮再看一下！

northwolves

原帖由 lj1226189 于 2010-12-15 12:50 发表
运行了一下，发现部部份19的水样指标不完全相同！烦请狼版帮再看一下！

没问题啊。
监测点编号        相似监测点
13986711         13987859(19)
13385380         13896357(15)
13624876         13622165(15)
13457824         13199625(19)
14084342         13873232(18)
13534598         13190147(15)
13145295         13152843(15)
13152843         13990756(15) 13213573(16) 13770919(15)
13990756         13213573(16) 13770919(15) 13911972(15)
16096327         8666071(15)
8666071         13213573(16)
13213573         13770919(16) 13149746(16)
13251692         13139956(15)
13958047         13118814(15)
13769741         13370078(19)
13621617         13833869(15)
13409037         13176296(15)
13240654         13241170(15)

重运行一遍试试

lj1226189

原来的数据没有清除

再次感谢
1

northwolves

15/19的数据完全相同，尤其有的数字甚至精确到小数点后2位，绝对有作假的嫌疑。
水质性命攸关，一定要罚他们个倾家荡产。

lj1226189

狼版主有功于水质监测工作，真是功德无量啊[ ！
向版主表示由衷的感谢！

wanghaiqn1957

原帖由 江左 于 2010-12-15 09:52 发表
刚才1万行运行20分钟没结束，100行测试的运行了8秒

Sub 水样检测()

'19个指标中，要求15个以上（含）相同

Dim i1row As Integer, i2colume As Integer, counter As Integer

For i1row = 2 To 100 '实际有 ...

狼版的才3分钟，看来是用数组的要快很多

江左

原帖由 wanghaiqn1957 于 2010-12-15 15:19 发表

狼版的才3分钟，看来是用数组的要快很多

数组娃完全没有概念，
回头做一个程序进程的监控，学习一下到底慢在啥地方