|
|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
Sub 值日领导监控室统计()
Application.ScreenUpdating = False
Dim ar As Variant
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("原始数据")
r = .Cells(Rows.Count, 1).End(xlUp).Row
y = .Cells(2, Columns.Count).End(xlToLeft).Column
If r < 3 Or y < 5 Then MsgBox "原始数据为空！": End
ar = .Range(.Cells(2, 1), .Cells(r, y))
End With
With ActiveSheet
.UsedRange.Offset(3).Borders.LineStyle = 0
.UsedRange.Offset(3, 1) = Empty
mc = ActiveSheet.Name
yy = .Cells(3, Columns.Count).End(xlToLeft).Column
rs = .Cells(Rows.Count, 1).End(xlUp).Row
br = .Range(.Cells(2, 1), .Cells(rs, yy))
nj = .[a2]
For j = 2 To UBound(br, 2)
If br(1, j) = "" Then br(1, j) = br(1, j - 1)
s = br(1, j) & "|" & br(2, j)
d(s) = j
Next j
For i = 2 To UBound(ar)
If ar(i, 1) = nj And ar(i, 3) = mc Then
t = ar(i, 2) + 2
For j = 5 To UBound(ar, 2)
ss = ar(i, 4) & "|" & ar(1, j)
lh = d(ss)
If lh <> "" Then
br(t, lh) = br(t, lh) + ar(i, j)
End If
Next j
End If
Next i
.[a2].Resize(UBound(br), UBound(br, 2)) = br
.[a2].Resize(UBound(br), UBound(br, 2)).Borders.LineStyle = 1
End With
Set d = Nothing
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2025-3-22 00:30
楼主