|
楼主 |
发表于 2012-3-23 16:52
|
显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
tianmashi 发表于 2012-3-22 20:25
老师您好,我想麻烦您一下,我有个疑问,附件里的表2是做好的,我想变动一下,程序应该怎么修改呢?
即 ...
代码帮你写好了。实际上没有什么难度。
只要会计算相应数组坐标位置就可以了。- Sub test()
- rw = Cells(65536, Range("data").Column).End(3).Row + 1
- cl = Range("data").End(2).Column - Range("data").Column
- arr = [b2].Resize(rw, cl)
-
- n = Cells(65536, Range("input").Column + 1).End(3).Row - 1
- brr = Range("input").Offset(1, 1).Resize(n, 2)
-
- ReDim crr1(n * 3, 0)
- ReDim crr2(cl * 3 * 3, (rw / 3 - 1) \ 3)
- ReDim k2((rw / 3 - 1) \ 3)
- ReDim crr3(cl * 3 * 39, (rw / 3 - 1) \ 39)
- ReDim k3((rw / 3 - 1) \ 39)
-
- For i = 1 To n
- x = Val(brr(i, 1)) - 1
- y = Val(brr(i, 2))
- t1 = arr(x * 3 + 1, y)
- t2 = arr(x * 3 + 2, y)
-
- crr1(k1, 0) = t1
- crr1(k1 + 1, 0) = t2
- k1 = k1 + 3
-
- j2 = x \ 3
- crr2(k2(j2), j2) = t1
- crr2(k2(j2) + 1, j2) = t2
- k2(j2) = k2(j2) + 3
-
- j3 = x \ 39
- crr3(k3(j3), j3) = t1
- crr3(k3(j3) + 1, j3) = t2
- k3(j3) = k3(j3) + 3
-
- Next
-
- Range("output1").Offset(1, 1).Resize(k1) = crr1
- t2 = Application.Large(k2, 1)
- Range("output2").Offset(1, 1).Resize(t2, UBound(crr2, 2) + 1) = crr2
- t3 = Application.Large(k3, 1)
- Range("output3").Offset(1, 1).Resize(t3, UBound(crr3, 2) + 1) = crr3
- End Sub
复制代码 |
|