|
|
Sub 工作量统计()
Dim ar As Variant
Dim br(), cr()
Dim d As Object, dc As Object, dic As Object, dicc As Object
Set d = CreateObject("scripting.dictionary")
Set dc = CreateObject("scripting.dictionary")
Set dic = CreateObject("scripting.dictionary")
Set dicc = CreateObject("scripting.dictionary")
With Sheets("教师课时统计")
r = .Cells(Rows.Count, 1).End(xlUp).Row
If r < 2 Then MsgBox "教师课时统计为空！": End
ar = .Range("a1:h" & r)
End With
For i = 2 To UBound(ar)
s = ar(i, 1)
If s <> "" Then
If Not d.exists(s) Then Set d(s) = CreateObject("scripting.dictionary")
d(s)(i) = ""
End If
Next i
ReDim br(1 To d.Count, 1 To 7)
For Each k In d.keys
n = n + 1
br(n, 1) = k
dc.RemoveAll: dic.RemoveAll: dicc.RemoveAll
m = 0
ReDim cr(1 To d(k).Count, 1 To 4)
For Each kk In d(k).keys
If ar(kk, 3) <> "" Then
br(n, 2) = ar(kk, 2)
zd = ar(kk, 3) & "|" & ar(kk, 5) & "|" & ar(kk, 6) ''年级，学科，课时数
zf = ar(kk, 5)
m = m + 1
For j = 3 To 6
cr(m, j - 2) = ar(kk, j)
Next j
If dc(zd) = "" Then
dc(zd) = ar(kk, 4)
Else
dc(zd) = dc(zd) & "," & ar(kk, 4)
End If
br(n, 4) = br(n, 4) + ar(kk, 6)
br(n, 5) = br(n, 5) + ar(kk, 8)
dic(zf) = ""
dicc(ar(kk, 3)) = ""
End If
Next kk
For Each kc In dc.keys
rr = Split(kc, "|")
If InStr(dc(kc), ",") > 0 Then
w = "各"
Else
w = ""
End If
If br(n, 3) = "" Then
br(n, 3) = "【" & rr(0) & "】" & dc(kc) & "班" & rr(1) & w & rr(2) & "节"
Else
br(n, 3) = br(n, 3) & ";【" & rr(0) & "】" & dc(kc) & "班" & rr(1) & w & rr(2) & "节"
End If
Next kc
If dc.Count > 1 Then br(n, 6) = 1
If dic.Count > 1 Then br(n, 7) = 1
Next k
With Sheets("教师工作量")
.[a1].CurrentRegion.Offset(1).Borders.LineStyle = 0
.[a1].CurrentRegion.Offset(1) = Empty
.[a2].Resize(n, UBound(br, 2)) = br
.[a2].Resize(n, UBound(br, 2)).Borders.LineStyle = 1
End With
Set d = Nothing
Set dc = Nothing
Set dic = Nothing
Set dicc = Nothing
MsgBox "ok!"
End Sub
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2024-10-2 22:26
楼主