批量求每行出现数字的个数

kandhong88

老师：
    我请教的是：批量求每行出现数字的个数。
    原理如下：
    1、统计C2:F12每行出现数字的个数，在C14:C24显示。函数为"=COUNTA(C2:F2)"
    2、统计G2:J12每行出现数字的个数，在D14:D24显示。函数为"=COUNTA(G2:J12)"
    3、统计K2:N12每行出现数字的个数，在E14:E24显示。函数为"=COUNTA(K2:N2)"
    如果数据量很大的时候，函数运算很慢，请老师给予VBA解法。
    批量求每行出现数字的个数.rar (9.24 KB, 下载次数: 13)

2018-6-22 10:38 上传

点击文件名下载附件

Chip_Kenny

1. Sub zz()
   
2. Dim ar, b(), n%
   
3. ar = [c2:n12].Value
   
4. ReDim b(1 To UBound(ar), 1 To 3)
   
5. n = UBound(ar, 2) / UBound(b, 2)
   
6. For i = 1 To UBound(ar)
   
7.     For j = 0 To 2
   
8.         For jj = 1 To n
   
9.             If Len(ar(i, j * n + jj)) Then b(i, j + 1) = b(i, j + 1) + 1
   
10.         Next
    
11.     Next
    
12. Next
    
13. [c14].Resize(i - 1, 3) = b
    
14. End Sub

复制代码

kandhong88

Chip_Kenny 老师：
       您的VBA已收悉，正解！还有一个问题请教。
      思路如下：上述数据是每4列进行统计的，如果扩展开来，用单元格Q6进行列数控制，VBA如何写呢，请老师指教！
      

excelhomezql

可以根据实际调整

Chip_Kenny

kandhong88 发表于 2018-6-22 11:29
Chip_Kenny 老师：
       您的VBA已收悉，正解！还有一个问题请教。
      思路如下：上述数据是每4列进 ...

1. Sub zz()
   
2. Dim ar, b(), n%, m%
   
3. ar = [c2:n12].Value
   
4. m = [q6].Value
   
5. ReDim b(1 To UBound(ar), 1 To m)
   
6. n = UBound(ar, 2) / m
   
7. For i = 1 To UBound(ar)
   
8.     For j = 0 To m - 1
   
9.         For jj = 1 To n
   
10.             If Len(ar(i, j * n + jj)) Then b(i, j + 1) = b(i, j + 1) + 1
    
11.         Next
    
12.     Next
    
13. Next
    
14. [c14].Resize(i - 1, m) = b
    
15. End Sub

复制代码

hcm19522

A16:F26=IF(COLUMN(A1)>ROUNDUP(12/$N$14,),"",SUMPRODUCT(N(OFFSET($A2,,MAX((COLUMN(A1)-1)*$N$14),,$N$14)>0)))

格式化:L12格式化=MOD(INT((COLUMN(A2)-1)/$N$14)+1,2)=0

kandhong88

Chip_Kenny 发表于 2018-6-22 11:10

Chip_Kenny老师，非常感谢，辛苦了！！

kandhong88

Chip_Kenny 发表于 2018-6-22 12:30

Chip_Kenny老师：
    这是您向我提供的VBA作品。 原理如下：用Q6控制数据区C2:N12平分个数，然后求平分区域每行数据的个数。
    举例说明：Q6=3时，数据区C2:N12平均分成3份，每行含有的数据分别在C14:N24显示。
    此VBA有一个不足之处：
    当Q6=6时，显示的数据为6列；
    而当Q6=3时，在显示的数据应为3列的同时，还有Q6=6时的数据。
    我想要的结果是：当Q6=3时，显示的数据为3列；Q6=6时，显示的数据为6列；
    请老师修改此VBA。
    批量求每行出现数字的个数.rar (17.41 KB, 下载次数: 2)

2018-6-24 21:20 上传

点击文件名下载附件

   

Chip_Kenny

kandhong88 发表于 2018-6-24 21:21
Chip_Kenny老师：
    这是您向我提供的VBA作品。 原理如下：用Q6控制数据区C2:N12平分个数，然后求平分 ...

加一句清舊資料即可。

1. Sub zz()
   
2. Dim ar, b(), n%, m%
   
3. ar = [c2:n12].Value
   
4. m = [q6].Value
   
5. ReDim b(1 To UBound(ar), 1 To m)
   
6. n = UBound(ar, 2) / m
   
7. For i = 1 To UBound(ar)
   
8.     For j = 0 To m - 1
   
9.         For jj = 1 To n
   
10.             If Len(ar(i, j * n + jj)) Then b(i, j + 1) = b(i, j + 1) + 1
    
11.         Next
    
12.     Next
    
13. Next
    
14. [c14].CurrentRegion.Value = ""
    
15. [c14].Resize(i - 1, m) = b
    
16. End Sub

复制代码