|
|
Private Sub Worksheet_Change(ByVal T As Range)
If T.Row > 4 And T.Column = 4 Then
If T.Count > 1 Then End
If T.Value = "" Then End
Dim ar As Variant
Dim i As Long, r As Long
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("参数表")
r = .Cells(Rows.Count, 2).End(xlUp).Row
ar = .Range("a1:c" & r)
End With
zd = T.Value
For i = 2 To UBound(ar)
If ar(i, 2) = zd Then
If ar(i, 3) <> "" Then
d(ar(i, 3)) = ""
End If
End If
Next i
T.Offset(, 1).Select
With T.Offset(, 1).Validation
.Delete
.Add 3, 1, 1, Join(d.keys, ",")
End With
End If
If T.Row > 4 And T.Column = 5 Then
If T.Count > 1 Then End
If T.Value = "" Then End
If T.Offset(, -1) = "" Then End
Set d = CreateObject("scripting.dictionary")
With Sheets("参数表")
r = .Cells(Rows.Count, 2).End(xlUp).Row
ar = .Range("a1:e" & r)
End With
zf = T.Offset(, -1).Value
zd = T.Value
For i = 2 To UBound(ar)
If ar(i, 2) = zf And ar(i, 3) = zd Then
Cells(T.Row, 6) = ar(i, 4)
Cells(T.Row, 16) = ar(i, 5)
Exit For
End If
Next i
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal T As Range)
If T.Row > 4 And T.Column = 4 Then
If T.Count > 1 Then End
Dim ar As Variant
Dim i As Long, r As Long
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("参数表")
r = .Cells(Rows.Count, 2).End(xlUp).Row
ar = .Range("b1:b" & r)
End With
For i = 2 To UBound(ar)
If ar(i, 1) <> "" Then
d(ar(i, 1)) = ""
End If
Next i
With T.Validation
.Delete
.Add 3, 1, 1, Join(d.keys, ",")
End With
End If
End Sub
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2024-3-13 11:22
楼主
