[已解决]请指点一个自动求总分的宏，谢谢！

bipl607

请教各位高手：

有时是求3科总分，有时是求5科、6科总分，每次在不同的列都求和再下拉，非常不爽，能不能做一个宏，根据前面的科目数(如果是3科就在G列求和，如果是5科就在I列求和。。。)，点一下宏就自动求出总分，谢谢！

最佳答案

月排行榜 / 总排行榜

殿堂之上

2013-8-30 23:30

你看一下

跳转到最佳答案楼层

殿堂之上

你看一下

1032446692

bipl607

谢谢楼上的各位朋友，2楼的代码按多一次会自动把自身相加，3楼的代码多按一次会把前面的数据去掉，怎么改？

1032446692

bipl607 发表于 2013-8-30 23:53
谢谢楼上的各位朋友，2楼的代码按多一次会自动把自身相加，3楼的代码多按一次会把前面的数据去掉，怎么改？

多按一次会把前面的数据去掉？什么意思？

bipl607

3楼的代码，前面少1科，求和也只能在J列，不会自动放在I列

bipl607

1032446692 发表于 2013-8-30 23:56
多按一次会把前面的数据去掉？什么意思？

我把J列去掉后，多按一次会把前面一列的数据去掉

1032446692

bipl607 发表于 2013-8-31 00:10
我把J列去掉后，多按一次会把前面一列的数据去掉

1. 
   
2. Sub test()
   
3. Dim rng As Range, a, i, j, arr, arrb
   
4. a = Cells(Rows.Count, 3).End(xlUp).Row - 1
   
5. ReDim arrb(1 To a, 1 To 1)
   
6. Set rng = Cells(1, Columns.Count).End(xlToLeft)
   
7. If rng.Value = "总分" Then
   
8. arr = Cells(2, 4).Resize(a, rng.Column - 4)
   
9. For i = 1 To a
   
10. For j = 1 To rng.Column - 4
    
11. arrb(i, 1) = arrb(i, 1) + arr(i, j)
    
12. Next j
    
13. Next i
    
14. Cells(2, rng.Column).Resize(a) = arrb
    
15. End If
    
16. End Sub
    

复制代码

最后一列（也就是含有“总分”那一列）是不能删的，那两个字也不要删，也不要改。我在这里是依它为汇总的标志。

bipl607

1032446692 发表于 2013-8-31 00:24
最后一列（也就是含有“总分”那一列）是不能删的，那两个字也不要删，也不要改。我在这里是依它为汇总的 ...

1032446692老师，能不能，点一下宏就自动求出总分，不必先打上总分两字呢，谢谢！

1032446692

1. 
   
2. Sub test()
   
3. Dim rng As Range, a, i, j, arr, arrb
   
4.     a = Cells(Rows.Count, 3).End(xlUp).Row - 1
   
5.     ReDim arrb(1 To a, 1 To 1)
   
6.     Set rng = Cells(1, Columns.Count).End(xlToLeft).Offset(, 1)
   
7.         arr = Cells(2, 4).Resize(a, rng.Column - 4)
   
8.         For i = 1 To a
   
9.             For j = 1 To rng.Column - 4
   
10.                 arrb(i, 1) = arrb(i, 1) + arr(i, j)
    
11.             Next j
    
12.         Next i
    
13.     Cells(2, rng.Column).Resize(a) = arrb
    
14. End Sub
    

复制代码