[已解决]再次求助(把表格中的公式改成VBA运行)

ccq000000

我过去做的一份表格因公式太多运行极慢,试用VBA数组来做但水平太差做不出来,不知道这样的表格能不能用VBA方便的解决?
（最好能用VBA数组来做,请不要录制宏，最想要的是用数组及FOR循环完成）vba工程已经解锁!
tryout.rar (9.54 KB, 下载次数: 18)

2014-2-26 21:16 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

pengyx

2014-2-26 22:30

是否达到要求，如没有我好来抢金币。达到了我就不下附件了

跳转到最佳答案楼层

fffox

求助贴居然工程还加密

1. Private Sub Worksheet_Activate()
   
2.     Dim Arr, Brr, i&, j%, k%, EndRow&, EndCol%
   
3.     Dim sNum#, sKg#, fNum#, fKg#
   
4.     With Sheets(1)
   
5.         EndRow = .Cells(Rows.Count, 1).End(xlUp).Row
   
6.         EndCol = .Cells(4, Columns.Count).End(xlToLeft).Column
   
7.         Arr = .Range("d5:k" & EndRow).Value
   
8.         Brr = .Range("l5", .Cells(EndRow, EndCol)).Value
   
9.     End With
   
10.     For i = 1 To UBound(Arr)
    
11.         For j = 1 To UBound(Brr, 2) Step 4
    
12.             sNum = sNum + Val(Brr(i, j))
    
13.             sKg = sKg + Val(Brr(i, j + 1))
    
14.             fNum = fNum + Val(Brr(i, j + 2))
    
15.             fKg = fKg + Val(Brr(i, j + 3))
    
16.         Next
    
17.         Arr(i, 3) = sNum
    
18.         Arr(i, 4) = sKg
    
19.         Arr(i, 5) = fNum
    
20.         Arr(i, 6) = fKg
    
21.         Arr(i, 7) = Arr(i, 1) + Arr(i, 3) - Arr(i, 5)
    
22.         Arr(i, 8) = Arr(i, 2) + Arr(i, 4) - Arr(i, 6)
    
23.     Next
    
24.     Range("d5").Resize(UBound(Arr), 8) = Arr
    
25. End Sub

复制代码

ccq000000

fffox 发表于 2014-2-26 10:35
求助贴居然工程还加密

不好意思我忘了把工程解锁.我先看一下你的代码谢谢

ccq000000

fffox 发表于 2014-2-26 10:35
求助贴居然工程还加密

当运行代码后,不能自动计算移动加权平均的发出重量.(附件工程已经解锁).比如我1号收入数量5根,重量是10KG,2号改入5根,重量是11.2KG,那么3号我发出4根,移动加权的发出重量是多少?这个用你提供的代码不能计算.附件已经重上传 tryout.rar (10.56 KB, 下载次数: 5)

2014-2-26 21:32 上传

点击文件名下载附件

fffox

ccq000000 发表于 2014-2-26 21:32
当运行代码后,不能自动计算移动加权平均的发出重量.(附件工程已经解锁).比如我1号收入数量5根,重量是10KG ...

继续改了一下代码。原先我的那段代码应该放在工作表事件中
tryout.rar (13.12 KB, 下载次数: 6)

2014-2-26 22:03 上传

点击文件名下载附件

ccq000000

fffox 发表于 2014-2-26 22:03
继续改了一下代码。原先我的那段代码应该放在工作表事件中

你的代码为什么没放在selection change事件里而是放在激活事件里?

pengyx

是否达到要求，如没有我好来抢金币。达到了我就不下附件了

ccq000000

pengyx 发表于 2014-2-26 22:30
是否达到要求，如没有我好来抢金币。达到了我就不下附件了

请你来做

ccq000000

pengyx 发表于 2014-2-26 22:30
是否达到要求，如没有我好来抢金币。达到了我就不下附件了

欢迎你来抢金币.

ccq000000

pengyx 发表于 2014-2-26 22:30
是否达到要求，如没有我好来抢金币。达到了我就不下附件了

请你下附件吧,金币有的是.