Private Sub Worksheet_Change(ByVal Target As Range)
Dim nRow%, Arr(), cMc$, cPc$, cTxt$, nSum!
If Target.Row =1 Or Target.Column <>4 Then Exit Sub
If Target.CountLarge >1 Then Exit Sub
cMc = Target.Offset(0,-1).Value
cPc = Target.Value
If cMc ="" Or cPc ="" Then Exit Sub
For sh =0 To 1
With Sheets(Array("期初","入库")(sh))
nRow =.Range("a1048576").End(xlUp).Row
Arr =.Range("a1:e"& nRow).Value
End With
For i =2 To nRow
If Arr(i,2+ sh)= cMc And Arr(i,3+ sh)= cPc Then
nSum = nSum + Arr(i,4+ sh)
End If
Next
Next
nRow = Target.Row -1
With Me
Arr =.Range("a1:e"& nRow).Value
End With
For i =2 To nRow
If Arr(i,3)= cMc And Arr(i,4)= cPc Then
nSum = nSum - Arr(i,5)
End If
Next
With Target.Offset(0,1).Validation
.Delete
.Add 2,1,8, nSum
.InputTitle ="最大值".InputMessage = nSum
End With
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim nRow%, Arr(), cMc$, cTxt$, sh%
If Target.Row =1 Or Target.Column <>4 Then Exit Sub
If Target.CountLarge >1 Then Exit Sub
cMc = Target.Offset(0,-1).Value
If cMc ="" Then Exit Sub
For sh =0 To 1
With Sheets(Array("期初","入库")(sh))
nRow =.Range("a1048576").End(xlUp).Row
Arr =.Range("a1:d"& nRow).Value
End With
For i =2 To nRow
If Arr(i,2+ sh)= cMc Then
If Not cTxt &"," Like "*,"& Arr(i,3+ sh)&",*" Then
cTxt = cTxt &","& Arr(i,3+ sh)
End If
End If
Next
Next
With Target.Validation
.Delete
If cTxt <>"" Then .Add 3,1,1, cTxt
End With
End Sub