用VBA数组分别对白12/夜12/休求次数和合计

绿色心情小天使

E友大家好：

用Vba数组对考勤表分别对白12和夜12及休求次数，小计为白12+夜12.
XX2024考勤记录(10月).zip (62.12 KB, 下载次数: 3)

2024-10-19 10:05 上传

点击文件名下载附件

longwin

用公式就很方便：

绿色心情小天使

longwin 发表于 2024-10-19 10:38
用公式就很方便：

其它人容易帮我公式改掉

longwin

附件供参考（VBA代码）

绿色心情小天使

longwin 发表于 2024-10-19 11:22
附件供参考（VBA代码）

你好，晚上好
     附件中的小计是白班（白12）加夜班（夜12）的合计。

longwin

绿色心情小天使 发表于 2024-10-19 21:55
你好，晚上好
     附件中的小计是白班（白12）加夜班（夜12）的合计。

改一下：
Sub tj()
Set sh = Sheets("10")
Set d = CreateObject("scripting.dictionary")
jsh = sh.[a15].End(xlUp).Row
arr = sh.Range("C6:AF" & jsh).Value
crr = sh.Range("AH5:AK5")
ReDim Brr(1 To jsh - 5, 1 To 4)
For i = 1 To UBound(arr)
d.RemoveAll
    For j = 1 To UBound(arr, 2)
    If arr(i, j) <> "" Then
        d(arr(i, j)) = d(arr(i, j)) + 1
    End If
    Next
    For m = 1 To UBound(crr, 2) - 1
        Brr(i, m) = d(crr(1, m))
    Next
    Brr(i, 4) = Brr(i, 1) + Brr(i, 2)
Next
sh.[ah6].Resize(UBound(Brr), UBound(Brr, 2)) = Brr
Set d = Nothing
End Sub

Qs18

1. Sub qs() '2024/10/19
   
2. Dim arr, i, dic
   
3. Set dic = CreateObject("scripting.dictionary")
   
4. With Sheet55
   
5.     arr = .Range("c6:af10")
   
6.     Brr = .Range("ah5:ak10").Value
   
7.     For i = 1 To UBound(arr)
   
8.         dic.RemoveAll
   
9.         For j = 1 To UBound(arr, 2)
   
10.             s = arr(i, j)
    
11.             If s <> Empty Then
    
12.                 If Not dic.exists(s) Then
    
13.                     dic(s) = 1
    
14.                 Else
    
15.                     dic(s) = dic(s) + 1
    
16.                 End If
    
17.             End If
    
18.                         
    
19.         Next j
    
20.         For b = 1 To UBound(Brr, 2)
    
21.             Brr(i + 1, b) = dic(Brr(1, b))
    
22.         Next b
    
23.         Brr(i + 1, 4) = Brr(i + 1, 1) + Brr(i + 1, 2)
    
24.     Next i
    
25. .Range("ah5").Resize(UBound(Brr), UBound(Brr, 2)) = Brr
    
26. End With
    
27. Set dic = Nothing
    
28. End Sub

复制代码

Qs18

试试...........

Qs18

试试...............