[已解决]这段代码运行15分钟，恳请高手帮助优化

xuesheng1 · 发表于 2016-1-4 12:49

本帖最后由 xuesheng1 于 2016-1-4 16:35 编辑

我有一段内测对比大小代码，在我的笔记本上要运行15分钟才能结束（i7加固态硬盘16G内存），恳请高手帮助，万分感谢！    其中 crr 是由前期内存数组计算得出，只有在2013以上版本才能运行（2007以下会内存溢出），为了上传附件，crr 改为提取单元格了

Sub 对比()
Dim arr(1 To 5000, 1 To 4), krr, crr
Dim t&, x&, y&, w&

Range("i2:l5000") = ""
krr = [a1].CurrentRegion    '这里有3000多行8列
crr = [n1].CurrentRegion    '这里有500多万行12列

For x = 2 To UBound(krr)
      t = t + 1
         For y = 2 To UBound(crr)
            If krr(x, 1) < crr(y, 1) Then GoTo 30
            If krr(x, 2) < crr(y, 2) Then GoTo 30
            If krr(x, 3) > crr(y, 3) Then GoTo 30
            If krr(x, 4) > crr(y, 4) Then GoTo 30
            If krr(x, 5) < crr(y, 5) Then GoTo 30
            If krr(x, 6) < crr(y, 6) Then GoTo 30
            If krr(x, 7) < crr(y, 7) Then GoTo 30
            If krr(x, 8) < crr(y, 8) Then GoTo 30

                  For w = 1 To 4
                     arr(x, w) = arr(x, w) + crr(y, w + 8)
                  Next w
30
         Next y
Next x

[i2].Resize(t, 4) = arr

End Sub

求助.rar (12.54 KB, 下载次数: 7)

2016-1-4 12:49 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

香川群子

2016-1-4 14:29

像我这样，IF判断语句老老实实地写成嵌套结构，速度就可以提高40%将近1倍。

因为Goto语句效率较低。

Sub test2(krr, crr)
Dim arr() ', krr, crr
Dim i&, j&, k&, m&, n&, tms#
tms = Timer
' krr = [a1].CurrentRegion '3,000*8
' crr = [n1].CurrentRegion '5,000,000*12
m = UBound(crr)
n = UBound(krr)
ReDim arr(2 To n, 9 To 12)
For i = 2 To n 'UBound(krr)
For j = 2 To m 'UBound(crr)
If krr(i, 1) >= crr(j, 1) Then
If krr(i, 2) >= crr(j, 2) Then
If krr(i, 3) <= crr(j, 3) Then
If krr(i, 4) <= crr(j, 4) Then
If krr(i, 5) >= crr(j, 5) Then
If krr(i, 6) >= crr(j, 6) Then
If krr(i, 7) >= crr(j, 7) Then
If krr(i, 8) >= crr(j, 8) Then
For k = 9 To 12
arr(i, k) = arr(i, k) + crr(j, k)
Next k
End If
End If
End If
End If
End If
End If
End If
End If
Next j
Next i
' MsgBox Format(Timer - tms, "0.000s")
' Range("i2").Resize(UBound(krr) - 1, 4) = arr
End Sub

复制代码

跳转到最佳答案楼层

香川群子 · 发表于 2016-1-4 14:29

像我这样，IF判断语句老老实实地写成嵌套结构，速度就可以提高40%将近1倍。

因为Goto语句效率较低。

Sub test2(krr, crr)
Dim arr() ', krr, crr
Dim i&, j&, k&, m&, n&, tms#
tms = Timer
' krr = [a1].CurrentRegion '3,000*8
' crr = [n1].CurrentRegion '5,000,000*12
m = UBound(crr)
n = UBound(krr)
ReDim arr(2 To n, 9 To 12)
For i = 2 To n 'UBound(krr)
For j = 2 To m 'UBound(crr)
If krr(i, 1) >= crr(j, 1) Then
If krr(i, 2) >= crr(j, 2) Then
If krr(i, 3) <= crr(j, 3) Then
If krr(i, 4) <= crr(j, 4) Then
If krr(i, 5) >= crr(j, 5) Then
If krr(i, 6) >= crr(j, 6) Then
If krr(i, 7) >= crr(j, 7) Then
If krr(i, 8) >= crr(j, 8) Then
For k = 9 To 12
arr(i, k) = arr(i, k) + crr(j, k)
Next k
End If
End If
End If
End If
End If
End If
End If
End If
Next j
Next i
' MsgBox Format(Timer - tms, "0.000s")
' Range("i2").Resize(UBound(krr) - 1, 4) = arr
End Sub

复制代码

香川群子 · 发表于 2016-1-4 14:34

本帖最后由香川群子于 2016-1-4 15:11 编辑

如果需要进一步提高运算速度，那么可能需要对原始数据进行按列多key排序。

这样，也许就可以提前终止循环退出了。

比如，crr第1列升序排序。
之后对于krr的i行检查到crr的j行有不满足条件，即 If krr(i, 1) < crr(j, 1) Then 时，即可退出crr的剩余行检查了。因为排序以后的各行，都不可能满足条件。

这样一来，或许可以大大节约检查时间。

…………
但是，这个排序，还需要逐列进行。也很麻烦的说。

xuesheng1 · 发表于 2016-1-4 14:53

香川群子发表于 2016-1-4 14:29
像我这样，IF判断语句老老实实地写成嵌套结构，速度就可以提高40%将近1倍。

因为Goto语句效率较低。

谢谢您，我马上试试，太感谢了

xuesheng1 · 发表于 2016-1-4 14:55

香川群子发表于 2016-1-4 14:34
如果需要进一步提高运算速度，那么需要对原始数据进行按列多key排序。

这样，就可以提前终止循环退出了。 ...

对啊，您这个方法太好了，需要我这么做才能做到哪？

xuesheng1 · 发表于 2016-1-4 16:34

香川群子发表于 2016-1-4 14:34
如果需要进一步提高运算速度，那么可能需要对原始数据进行按列多key排序。

这样，也许就可以提前终止循环 ...

再次感谢您，您的代码我测试通过，节省了几分钟，看来这个 goto 还真不能用了，再有受您这段话的启发，我把最少通过率的列调整到第一个判断语句，虽然没有排序，但这样也节省了一些，总之现在用着快多了，向您学习，受益无穷

香川群子 · 发表于 2016-1-4 16:38

测试代码test3 和test4，楼主自己用大数据看一下运算速度。

改进方法：
① 对原始数据crr的第1列进行排序，得到对应的行索引值数组x。 (使用快速排序算法)
② 按krr逐行检查时
  1. 按数组x顺序检查、到第1列不满足条件时就停止。得到索引数组x中满足条件的k个值
  2. 按数组x顺序检查、提取满足第2列条件时的所有行索引存入新的索引数组y中有k个值
  3. 按数组y顺序检查、提取满足第3列条件时的所有行索引存入新的索引数组y中有k个值
……
  8. 依此类推，直至第8列条件也都满足时得到索引数组y中有k个值

  9. 如果k>1有效，则提取结果写入数组arr中
③ 全部krr行检查结束后，输出结果。

以上算法，应该速度更快……
但在数据量较少时，差异不明显、反而速度更慢一些（因为排序也要耗时。）

所以，要请楼主自己测试500万行数据的运算速度效果。

xuesheng1 · 发表于 2016-1-4 16:57

香川群子发表于 2016-1-4 16:38
测试代码test3 和test4，楼主自己用大数据看一下运算速度。

改进方法：

好的，我马上测试，万分感谢！

香川群子 · 发表于 2016-1-4 17:07

目前看，排序耗时也很大……有些得不偿失。

xuesheng1 · 发表于 2016-1-4 17:12

香川群子发表于 2016-1-4 17:07
目前看，排序耗时也很大……有些得不偿失。

我现在在计算，我先计算1万多行的看看时间，一会向您汇报

		自动登录	找回密码
密码			注册