Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$A$1" Then Exit Sub
Dim arr, sht, i, j, m, t, sum
sht = Split("在职 退休 离休")
ReDim brr(1 To 10 ^ 4, 1 To 3)
t = [a1].Value
For i = 0 To UBound(sht)
arr = Sheets(sht(i) & "工资").[a1].CurrentRegion
For j = 2 To UBound(arr, 1)
If arr(j, 6) = t Then
m = m + 1: sum = sum + arr(j, 5)
brr(m, 1) = m: brr(m, 2) = arr(j, 2): brr(m, 3) = arr(j, 5)
End If
Next j, i
m = m + 1: brr(m, 1) = "合计": brr(m, 3) = sum
With [a3]
.Resize(Rows.Count - 2, 3) = vbNullString
If m > 0 Then .Resize(m, 3) = brr
End With
End Sub |