python
复制代码
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