88万行的数据运算：如何编写代码来代替excel函数的运算，谢谢！

lwx228

liu-aguang 发表于 2014-10-30 17:56
看似简单,但不完全明白意图.最好模拟一二个结果例子,才容易看懂.

不好意思，重新上了附件，有公式在里面
AL2与B1比、AM2与C1比……，结果返回分别返回B2、C2单元格……
AL3与B1比、AM3与C1比……，结果返回分别返回B3、C3单元格……

如此将这种比较一直计算到AK列的最后一行为止。谢谢！

liu-aguang

lwx228 发表于 2014-10-30 20:45
不好意思，重新上了附件，有公式在里面
AL2与B1比、AM2与C1比……，结果返回分别返回B2、C2单元格……
...

无法打开压缩附件:测试一下下面代码,(原附件说明中的两个条件好像表达有误自己再仔细看看)

1. Sub test()
   
2.     Dim arr, brr, i&, j%
   
3.     Sheets("sheet1").Activate
   
4.     brr = Range("ak1").CurrentRegion
   
5.     arr = Range("a1").CurrentRegion.Resize(UBound(brr))
   
6.     For i = 2 To UBound(brr)
   
7.         For j = 3 To UBound(brr, 2)
   
8.             If InStr(brr(1, j), "反") = 0 Then
   
9.                 arr(i, j - 1) = IIf(brr(i, j) > arr(1, j - 1), 1, 0)
   
10.             Else
    
11.                 arr(i, j - 1) = IIf(brr(i, j) < arr(1, j - 1), 1, 0)
    
12.             End If
    
13.         Next
    
14.     Next
    
15.     Range("a1").Resize(UBound(arr), UBound(arr, 2)) = arr
    
16. End Sub
    

复制代码

ak47ok

liu-aguang 发表于 2014-10-31 08:58
无法打开压缩附件:测试一下下面代码,(原附件说明中的两个条件好像表达有误自己再仔细看看)

请教老师：
brr = Range("ak1").CurrentRegion
这数组对行列数的多少有无限制？或者说它的行列数上限是多少？
我象51楼那样调整计算方式，直接经88万行来运算，则运行到brr = Range("ak1").CurrentRegion
时就出错，提示资源不够！
要将88万行数据分次运算？要分几次？？

麻烦老师再指导，谢谢！

ak47ok

因为我使用了大型正交表，是32因素、31水平，共961次，再进行374个循环，要8——9天才能算完，
所以要重新个性代码。

ak47ok

自己能快速制作各大型正交表了：

liu-aguang

ak47ok 发表于 2014-11-20 18:22
请教老师：
brr = Range("ak1").CurrentRegion
这数组对行列数的多少有无限制？或者说它的行列数上限是 ...

应该不是行列限制的原因.你试着改为硬编码:
brr=range("ak1:be880000") 'be修改为数据实际占有的列标;880000修改为数据实际占有的行号.
如果通过,那么可能是ak1开始的数据区域与其它数据区域并没有分开.使用Currentregin定义数据区域,必须保证期望定义的数据区域的上下左右与其它数据区域之间相隔一个空行或空列.

ak47ok

liu-aguang 发表于 2014-11-20 19:29
应该不是行列限制的原因.你试着改为硬编码:
brr=range("ak1:be880000") 'be修改为数据实际占有的列标;88 ...

按老师的方法试了。
有改善，但到其他代码又有误：
我已将相关代码修改如下：
brr = Range("ak1:az880000")

arr = Range("a1:p880000").Resize(UBound(brr))
1、如果是按88万行、按5列，则代码能完成运算（即数据只到AP列）
2、如果是按88万行、按14列，则代码运行到最后一行提示资源不足（即数据只到AZ列）
   Range("a1").Resize(UBound(arr), UBound(arr, 2)) = arr
3、如果用brr=range("ak1:be880000") 、则对应 arr = Range("a1:U880000").Resize(UBound(brr))
    则代码运行到arr = Range("a1:U880000").Resize(UBound(brr))时、提示资源不足
4、如果只有60万行数据，则第3点的代码能运算完毕。

看来还是数据量太大的问题？
麻烦老师再次指导，谢谢！

liu-aguang

ak47ok 发表于 2014-11-21 16:15
按老师的方法试了。
有改善，但到其他代码又有误：
我已将相关代码修改如下：

1.既然用硬编码赋值,arr = Range("a1:p880000").Resize(UBound(brr))语句写法就不正确了.应该:
arr = Range("a1:p880000"),同样arr = Range("a1:U880000").Resize(UBound(brr)) 修改为:
arr = Range("a1:U880000")
本人电脑上运行你提及的第3点修改后语句,不会提示错误.(2010Excel)
2.你提及的第2点,经测试的确要提示错误.说明了一个问题:当数组写回工作表区域时,是有行列限制的.唯一的解决办法是循环数组arr,逐个单元格填充.但这是一个相当长的过程.
给你的建议:
1.即使上面的语句能正确进行,定义两个大数组,在运行的时候速度也是极其缓慢的.如果在一次运算的过程中并不需要读取全部行(880000行)的数据,那么就只需要定义要参加运算的行列区域为数组.(比如上次给你的代码,不就是只定义了一部分区域为数组吗?)
2.如果在一次运算中的确需要处理全部数据,则可考虑分段处理.

ak47ok

liu-aguang 发表于 2014-11-21 18:52
1.既然用硬编码赋值,arr = Range("a1:p880000").Resize(UBound(brr))语句写法就不正确了.应该:
arr = Ra ...

感谢老师的指导
通过试验，用上述代码我的电脑能同时运算40列、22万行的数据，效果还是比之前循环的速度要快。
所以想用第2种方法：在一次运算中的确需要处理全部数据,则可考虑分段处理

但我修改了不少时间还是没有得到正确的结果，麻烦老师继续指导，谢谢！
惭愧，我还是搞不定。再次劳烦您 ，谢谢！

liu-aguang

ak47ok 发表于 2014-11-23 11:29
感谢老师的指导
通过试验，用上述代码我的电脑能同时运算40列、22万行的数据，效果还是比之前循环的速度 ...

1. Sub Macro1()   '右区域数据行数必须在8行以上,否则会出错.
   
2.     Dim arr, ar1, ar2, n&, z%, i&, j%, sumR&, m%, k%
   
3.     Sheets(1).Activate
   
4.     Range("b1").CurrentRegion.Offset(2).ClearContents   '清除左区域第3行以下数据
   
5.     ar1 = Range(Range("b1"), Range("as1").End(xlToLeft)) '左区域第1行B1单元格开始赋值给数组ar1
   
6.     ar2 = Range(Range("aw1"), Range("iv1").End(xlToLeft)) '右区域第1行AW1单元格开始赋值给数组ar2
   
7.     sumR = Range("au1").CurrentRegion.Rows.Count - 2      '右区域除了1-2行的数据区域行总数
   
8.     n = Int(sumR / 4): m = sumR Mod 4                     '右区域数据分为4段处理,每段有n行,余数为m行.
   
9.     For z = 0 To 3                                        '循环四次,每次处理n行数据
   
10.         k = IIf(z = 3, m + n, n)                          '当循环到第四次时(最后一次),最后要处理行数为m+n行
    
11.         arr = Range("aw3").Offset(z * n).Resize(k, UBound(ar2, 2)) '每次要处理的数据赋值给数组arr,注意是从AW3单元格开始的.
    
12.         For i = 1 To UBound(arr)                          '该双循环是对数组arr处理,与原来的处理方式一样.
    
13.             For j = 1 To UBound(arr, 2)
    
14.                 If InStr(ar2(1, j), "反") = 0 Then
    
15.                     arr(i, j) = IIf(arr(i, j) > ar1(1, j), 1, 0)
    
16.                 Else
    
17.                     arr(i, j) = IIf(arr(i, j) < ar1(1, j), 1, 0)
    
18.                 End If
    
19.             Next
    
20.         Next
    
21.         Range("b" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(arr), UBound(arr, 2)) = arr '分别把每次处理后的结果写入左区域.
    
22.     Next
    
23. End Sub
    

复制代码