已解决感谢各位前辈。

zmhzmh1999 · 发表于 2011-6-28 12:14

原帖由 dsmch 于 2011-6-28 11:35 发表
把附件发到dsmch@163.com,帮你看看能否解决。

无论测试还是计算大量数据都需要时间，还请等待一会儿。。。

zmhzmh1999 · 发表于 2011-6-28 12:59

原帖由 dsmch 于 2011-6-28 11:35 发表
把附件发到dsmch@163.com,帮你看看能否解决。

刚计算完毕，文件很大，数据基本就是一个A1延伸出的五百列，五万多行矩形区域，前辈的代码提示溢出，代码如下，请看看是否好更改：
Sub Macro1() '提示内存溢出
Sheets("KKK").Select
Dim arr, brr()
arr = Range("A1:QT" & Range("a65536").End(xlUp).Row + 1)
ReDim brr(1 To UBound(arr) - 1, 1 To UBound(arr, 2))
For i = 1 To UBound(arr) - 1
For j = 1 To UBound(arr, 2)
If arr(i + 1, j) = 0 And Len(arr(i + 1, j)) > 0 Then
x = Application.WorksheetFunction.Rank(arr(i, j), Range(Cells(i, 1), Cells(i, "QT")))
brr(i, x) = arr(i, j)
End If
Next j
Next i
Sheets("LLL").Range("A1").Resize(UBound(brr), UBound(brr, 2)) = brr
End Sub

77839600 · 发表于 2011-6-28 16:13

初级选手

lummox · 发表于 2011-6-28 20:53

版主该注意了：近来删附件的帖子多了起来，这不是个好现象。
对这种求到答案就删附件的人，有必要提出警告！

[ 本帖最后由 lummox 于 2011-6-28 20:56 编辑 ]

wyzdddl · 发表于 2011-6-28 21:43

将这种人，列入黑名单，不许再提问

feng16888 · 发表于 2011-6-28 22:35

就是啊，楼主的附件呢，好好的做什么删除呢，不是开发计划中的一部分拿来测试，让人帮你写代码的吧

www505 · 发表于 2011-6-29 17:03

论坛就是提供一个让大家学习的平台，如果把附件删除了，对大家的学习是不利的，如果有保密的问题，提问者可以修改一下再上传附件，这样不是两全其美吗?

rbq555 · 发表于 2011-6-29 17:37

是啊，不见附件，还真是看不懂呢？

zmhzmh1999 · 发表于 2011-6-30 11:40

对上面几楼的朋友致歉，只是想问题解决提示一下，不想让其他朋友做无用功而已，附件删除为顺手为之，如果楼下没有已经完美解决的另外附件我是不会删除的，再次抱歉。

feng16888 · 发表于 2011-6-30 12:25

如果只是提示一下的，没有必要顺手删除吧，别人只是按你的附件做的，发表的时候多数会看看别人是否已经做出来了。不会介意做一下，充当练手之用的，如果你有权利的话，是不是也顺手把解决方法的也顺手删除了呢

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

[求助] 已解决感谢各位前辈。

评分

回复 24楼 lummox 的帖子