[已解决]求一个条件统计代码

56899

一个简单的条件统计表格，一般情况下函数可以搞定。但实际上每次都有500以上的列要统计，所以还是求大神帮助写个代码。
附件里说明，谢谢！ 求：条件统计的VBA.rar (11.06 KB, 下载次数: 7)

2014-8-14 11:27 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

xdragon

2014-8-14 11:58

1. Sub t()
   
2.    Dim arr, brr, re#(), i&, j%, irow&
   
3.    On Error Resume Next
   
4.    arr = Range(Range("A2").Value & ":" & Range("A3").Value).Value
   
5.    If Err.Number Then MsgBox "输入的单元格范围错误，请重新输入": Exit Sub
   
6.    brr = Range("D2").Resize(2, UBound(arr, 2)).Value
   
7.    ReDim re(1 To UBound(arr), 1 To 1)
   
8.    For j = 1 To UBound(arr, 2)
   
9.       For i = 1 To UBound(arr)
   
10.          If arr(i, j) >= brr(1, j) And arr(i, j) <= brr(2, j) Then re(i, 1) = re(i, 1) + 1
    
11.       Next
    
12.    Next
    
13.    irow = Cells(Rows.Count, 3).End(xlUp).Row
    
14.    If irow > 4 Then Range("C5:C" & irow).ClearContents
    
15.    Range("C5").Resize(UBound(re)) = re
    
16. End Sub

复制代码

跳转到最佳答案楼层

xdragon

1. 理解错意思了。请稍等3分钟。。。
   

复制代码

xdragon

1. Sub t()
   
2.    Dim arr, brr, re#(), i&, j%, irow&
   
3.    On Error Resume Next
   
4.    arr = Range(Range("A2").Value & ":" & Range("A3").Value).Value
   
5.    If Err.Number Then MsgBox "输入的单元格范围错误，请重新输入": Exit Sub
   
6.    brr = Range("D2").Resize(2, UBound(arr, 2)).Value
   
7.    ReDim re(1 To UBound(arr), 1 To 1)
   
8.    For j = 1 To UBound(arr, 2)
   
9.       For i = 1 To UBound(arr)
   
10.          If arr(i, j) >= brr(1, j) And arr(i, j) <= brr(2, j) Then re(i, 1) = re(i, 1) + 1
    
11.       Next
    
12.    Next
    
13.    irow = Cells(Rows.Count, 3).End(xlUp).Row
    
14.    If irow > 4 Then Range("C5:C" & irow).ClearContents
    
15.    Range("C5").Resize(UBound(re)) = re
    
16. End Sub

复制代码

56899

xdragon 发表于 2014-8-14 11:58

谢谢老师的代码！暂时没有发现问题，很给力。