|
Sub 筛选()
Application.ScreenUpdating = False
Dim ar As Variant
With Sheets("人员信息表")
r = .Cells(Rows.Count, 1).End(xlUp).Row
If r < 2 Then MsgBox "人员信息表为空!": End
ar = .Range("a1:o" & r)
End With
Dim br()
ReDim br(1 To UBound(ar), 1 To 8)
For i = 2 To UBound(ar)
If Trim(ar(i, 13)) = "女" Then
If Trim(ar(i, 2)) <> "退休" And Trim(ar(i, 3)) <> "领导" Then
n = n + 1
br(n, 1) = n
br(n, 2) = ar(i, 1)
br(n, 3) = ar(i, 2)
br(n, 4) = Year(Date)
br(n, 5) = 1
br(n, 6) = "女"
br(n, 7) = 100
End If
End If
Next i
If n = "" Then MsgBox "没有符合条件的数据!": End
With Sheets("自动报表")
.[a1].CurrentRegion.Offset(2).Clear
.[a3].Resize(n, 7) = br
.[a3].Resize(n + 1, 8).Borders.LineStyle = 1
.Cells(n + 3, 2) = "合计"
.Cells(n + 3, 7).FormulaR1C1 = "=SUM(R[-" & n & "]C:R[-1]C)"
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub
|
|