|
|
Sub 跨学科年级统计()
Dim ar As Variant
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
For Each k In d.keys
dc.RemoveAll: dic.RemoveAll
For Each kk In d(k).keys
If ar(kk, 3) <> "" Then
dc(ar(kk, 5)) = ""
dic(ar(kk, 3)) = ""
End If
Next kk
If dic.Count > 1 Then dicc(k) = 1
If dc.Count > 1 Then dicc(k) = dicc(k) & "," & 1
Next k
With Sheets("教师工作量")
rs = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("f2:g" & rs) = Empty
br = .Range("a1:g" & rs)
For i = 2 To UBound(br)
s = br(i, 1)
If s <> "" Then
zd = dicc(s)
If zd <> "" Then
rr = Split(zd, ",")
For j = 0 To UBound(rr)
br(i, j + 6) = rr(j)
Next j
End If
End If
Next i
.Range("a1:g" & rs) = br
End With
Set d = Nothing
Set dc = Nothing
Set dic = Nothing
Set dicc = Nothing
MsgBox "ok!"
End Sub |
|
楼主: lc16whj
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2024-10-5 10:00
