|
工作表事件
Private Sub Worksheet_SelectionChange(ByVal T As Range) '代码要放在工作表("物品出入库记录")中
'-----------------------B列----------------------
If T.Row > 1 And T.Column = 2 Then
Dim sht As Worksheet, arr, d As Object, i%, s, r, r1, s1
Set sht = Sheets("物品库存统计")
r = sht.Cells(Rows.Count, 1).End(3).Row
arr = sht.Range("a4:a" & r)
Set d = CreateObject("scripting.dictionary")
For i = 2 To UBound(arr)
s = arr(i, 1)
If Not d.exists(s) Then
d(s) = ""
End If
Next i
With Sheets("物品出入库记录").Cells(T.Row, T.Column).Validation '在区域制作筛选下拉菜单
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Join(d.keys, ",")
End With
Erase arr: Set d = Nothing
End If
'-----------------------I列----------------------
If T.Row > 3 And T.Column = 9 Then
Set d = CreateObject("scripting.dictionary")
Set sht = Sheets("物品库存统计")
r1 = sht.Cells(Rows.Count, 9).End(3).Row
arr = sht.Range("i4:i" & r1)
For i = 2 To UBound(arr)
s1 = arr(i, 1)
If Not d.exists(s1) Then
d(s1) = ""
End If
Next i
With Sheets("物品出入库记录").Cells(T.Row, T.Column).Validation '在区域制作筛选下拉菜单
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Join(d.keys, ",")
End With
Erase arr: Set d = Nothing
End If
End Sub
|
评分
-
1
查看全部评分
-
|