'此代码在B列创建数据有效性
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'非b列,退出
If Intersect([b:b], Target) Is Nothing Then Exit Sub
'不允许选择多行
If Target.Rows.Count > 1 Then Exit Sub
Dim arr
Set d = CreateObject("scripting.dictionary")
arr = Array("电费", "燃气费", "水费", "排污费", "垃圾处理费")
For i = 0 To UBound(arr)
If arr(i) <> "" Then d(arr(i)) = i
Next
s = Join(d.keys, ",")
With Target.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=s
End With
' Application.SendKeys "%{down}" '发出快捷键ATL+↓直接弹出下拉表、(有的系统无效,慎用)
Set d = Nothing
End Sub