[已解决]求助一个统计的代码

ryoryo66

cutecpu 发表于 2021-9-27 12:25
Sub demo()
   For Each sh In Sheets
      sh.[J4:J7] = sh.[MMULT(N(COUNTIF(B2:D2,K4:S7)>0),Z1:Z9+1 ...

谢谢老师,能不能用数组的方式,因为我要加入一些变量,用在范围里,所以这样的不会使用啊.

ryoryo66

cutecpu 发表于 2021-9-27 12:25
Sub demo()
   For Each sh In Sheets
      sh.[J4:J7] = sh.[MMULT(N(COUNTIF(B2:D2,K4:S7)>0),Z1:Z9+1 ...

老师啊,我是说能不能用数组的方法帮我写一个啊?

cutecpu

ryoryo66 发表于 2021-9-27 20:44
谢谢老师,能不能用数组的方式,因为我要加入一些变量,用在范围里,所以这样的不会使用啊.

Sub demo()
   Dim b(9)
   For Each sh In Sheets
      For Each v In Range("b2:d2").Value
         b(v) = 1
      Next
      col = Range("k4:s7").Column + Range("k4:s7").Columns.Count - 1
      For Each Rng In Range("k4:s7")
         k = k + b(Rng.Value)
         If Rng.Column = col Then Range("j" & Rng.Row) = k: k = 0
      Next
      Erase b
   Next
End Sub

lisongmei

ryoryo66 发表于 2021-9-27 20:40
老师,再帮我看看吧,怎么修改一下?

1. Sub cout()
   
2. Dim i, j, x, k As Integer
   
3. Dim dic
   
4. Dim rng As Range
   
5. Dim arr, arr1
   
6. Set dic = CreateObject("scripting.dictionary")
   
7. arr = Range("K4:S" & [k10000].End(xlUp).Row)
   
8. For Each rng In Range("b2:d2")
   
9.     If Len(rng.Value) <> 0 Then dic(rng.Value) = ""
   
10. Next
    
11. arr1 = dic.keys
    
12. Columns("j:j").ClearContents
    
13. For i = 1 To UBound(arr)
    
14.     For j = 1 To UBound(arr, 2)
    
15.         For x = 0 To UBound(arr1)
    
16.             If arr(i, j) = arr1(x) Then k = k + 1
    
17.         Next
    
18.     Next
    
19. Range("j" & i + 3) = k
    
20. k = 0
    
21. Next
    
22. End Sub

复制代码

ryoryo66

cutecpu 发表于 2021-9-27 21:19
Sub demo()
   Dim b(9)
   For Each sh In Sheets

谢谢老师了,这有个小问题.

当B2:D2出现有0的时候,统计就出错了, 这个怎么修改一下啊?