请问可以实现这样的动态级联及语意联想吗?麻烦各位高手来帮下忙!

george_lj

感谢达人谢谢分享

伍月焱马兔

蓝桥玄霜 发表于 2009-7-23 13:12

老师如果序列选项（取消A、B、C列） 改到F、G、H列代码怎样改呀！

YZC51

请参考
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Column < 6 Or Target.Column > 7 Then Exit Sub
Dim d, i&, Myr&, Arr
Set d = CreateObject("Scripting.Dictionary")
Myr = Sheet1.[a65536].End(xlUp).Row
Arr = Sheet1.Range("a2:c" & Myr)
If Target.Column = 6 Then
    Set d = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(Arr)
        d(Arr(i, 1)) = ""
    Next
    With Target.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
        Operator:=xlBetween, Formula1:=Join(d.keys, ",")
    End With
    Target.Offset(0, 1) = ""
    Target.Offset(0, 2) = ""
    Set d = Nothing
ElseIf Target.Column = 7 And Target.Offset(0, -1) <> "" Then
    Set d = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(Arr)
        If Arr(i, 1) = Target.Offset(0, -1).Text Then
            d(Arr(i, 2)) = ""
        End If
    Next i
    With Target.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
        Operator:=xlBetween, Formula1:=Join(d.keys, ",") 'aa
    End With
    Target.Offset(0, 1) = ""
    Set d = Nothing
ElseIf Target.Column = 8 And Target.Offset(0, -1) <> "" Then
    Set d = CreateObject("Scripting.Dictionary")
    bb = Cells(Target.Row, 1) & "|" & Cells(Target.Row, 2)
    For i = 1 To UBound(Arr)
        If Arr(i, 1) & "|" & Arr(i, 2) = bb Then
            d(Arr(i, 3)) = ""
        End If
    Next i
    With Target.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
        Operator:=xlBetween, Formula1:=Join(d.keys, ",")
    End With
    Set d = Nothing
End If
End Sub

tonghau

蓝桥玄霜 发表于 2009-7-23 13:12

老师这个代码里如果点击标题行，标题行也是实行数据有效性的，点击A1，B1,C1的标题就为空了，标题行的数据有效期可以不要吗？