[已解决]求一个 有条件多组求和的函数

开心又快乐

看似简单，琢磨好久未果，只好求助各位啦！附件有说明，先谢谢！ 有条件多组求和.zip (6.91 KB, 下载次数: 12)

2016-4-13 09:15 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

grf1973

2016-4-13 10:36

1. Sub 统计()
   
2.     Dim L1, L2, Ls, xMin, xMax
   
3.     L1 = [ax2]: L2 = [ax3]: Ls = L2 - L1 + 1 '要统计的列，列数
   
4.     xMin = [ax4]: xMax = [ax5] '和值区间
   
5.     arr = Range("J7:AS37")  '数据区域，根据实际情况自调
   
6.     ReDim brr(1 To UBound(arr), 1 To 1)
   
7.     c1 = L1 - 3      '根据要统计起始列换算数据区域中的列数
   
8.     For i = 1 To UBound(arr)
   
9.         brr(i, 1) = 0
   
10.         For j = c1 To UBound(arr, 2) Step 12
    
11.             s = 0
    
12.             For k = 1 To Ls
    
13.                 s = s + arr(i, j + k - 1)
    
14.             Next
    
15.             If s >= xMin And s <= xMax Then brr(i, 1) = brr(i, 1) + 1
    
16.         Next
    
17.     Next
    
18.     [az7].Resize(UBound(brr)) = brr
    
19. End Sub
    

复制代码

跳转到最佳答案楼层

grf1973

1. Sub 统计()
   
2.     Dim L1, L2, Ls, xMin, xMax
   
3.     L1 = [ax2]: L2 = [ax3]: Ls = L2 - L1 + 1 '要统计的列，列数
   
4.     xMin = [ax4]: xMax = [ax5] '和值区间
   
5.     arr = Range("J7:AS37")  '数据区域，根据实际情况自调
   
6.     ReDim brr(1 To UBound(arr), 1 To 1)
   
7.     c1 = L1 - 3      '根据要统计起始列换算数据区域中的列数
   
8.     For i = 1 To UBound(arr)
   
9.         brr(i, 1) = 0
   
10.         For j = c1 To UBound(arr, 2) Step 12
    
11.             s = 0
    
12.             For k = 1 To Ls
    
13.                 s = s + arr(i, j + k - 1)
    
14.             Next
    
15.             If s >= xMin And s <= xMax Then brr(i, 1) = brr(i, 1) + 1
    
16.         Next
    
17.     Next
    
18.     [az7].Resize(UBound(brr)) = brr
    
19. End Sub
    

复制代码

开心又快乐

grf1973 发表于 2016-4-13 10:36

非常感谢grf1973老师的VBA程序！