[已解决]如何实现这种动态的数据有效性----我做的错在哪里

股网千王

动态数据有效性.zip (14.87 KB, 下载次数: 13)

2013-7-3 11:58 上传

点击文件名下载附件 B列出现不同的内容，C列的数据有效性随者变化，B列不要做。请老师看看。我做的错在哪里？

最佳答案

月排行榜 / 总排行榜

wp8680

2013-7-3 16:17

股网千王 发表于 2013-7-3 13:18
老师您好，我测试了你的代码，若直接点击B列就会出现1004的错误”不能取得worksheetFounction的match属性 ...

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.     Dim ir%, x%, st$
   
3.     On Error GoTo ok
   
4.     If Target.Column = 2 Then
   
5.         ir = Application.WorksheetFunction.Match(Target.Offset(0, -1), Sheets("资料").Range("a:a"), 0)
   
6.         Do
   
7.             x = x + 1
   
8.         Loop Until (Sheets("资料").Range("a" & ir + x) = "" And Sheets("资料").Range("b" & ir + x) = "") Or Sheets("资料").Range("a" & ir + x) <> ""
   
9.         st = Sheets("资料").Range("b" & ir).Resize(x, 1).Address
   
10.         ActiveWorkbook.Names.Add Name:="二级", RefersTo:="=资料!" & st
    
11.         With Selection.Validation
    
12.             .Delete
    
13.             .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    
14.                  xlBetween, Formula1:="=二级"
    
15.         End With
    
16.     End If
    
17. ok:
    
18. End Sub

复制代码

跳转到最佳答案楼层

股网千王

这是我做的，错在哪里

那么的帅

股网千王 发表于 2013-7-3 12:00
这是我做的，错在哪里

1 不能实现动态
2 Case "电机" 不应该是Case "装电机"
3 Case "泵头"，不应该是 Case "装泵头"

爱疯

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim d, A, i, x
   
    If Target.Column = 1 Or Target.Count > 1 Then End
    x = Target.Offset(0, -1)
    If x = "" Then End
    A = Sheet1.Range("A1").CurrentRegion
    Set d = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(A)
        If x = A(i, 1) Then
            d(A(i, 2)) = ""
        End If
    Next i
    With Target.Validation
        .Delete
        .Add Type:=xlValidateList, Formula1:=Join(d.keys, ",")
    End With
End Sub
动态数据有效性2.rar (14.64 KB, 下载次数: 11)

2013-7-3 12:14 上传

点击文件名下载附件

股网千王

那么的帅 发表于 2013-7-3 12:11
1 不能实现动态
2 Case "电机" 不应该是Case "装电机"
3 Case "泵头"，不应该是 Case "装泵头"

问题不在这里，就是按照你说的改过来也不行的

股网千王

{:301:}

wp8680

动态数据有效性.rar (16.2 KB, 下载次数: 14)

2013-7-3 13:07 上传

点击文件名下载附件

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.     Dim ir%, x%, st$
   
3.     If Target.Column = 2 Then
   
4.         ir = Application.WorksheetFunction.Match(Target.Offset(0, -1), Sheets("资料").Range("a:a"), 0)
   
5.         Do
   
6.             x = x + 1
   
7.         Loop Until (Sheets("资料").Range("a" & ir + x) = "" And Sheets("资料").Range("b" & ir + x) = "") Or Sheets("资料").Range("a" & ir + x) <> ""
   
8.         st = Sheets("资料").Range("b" & ir).Resize(x, 1).Address
   
9.         ActiveWorkbook.Names.Add Name:="二级", RefersTo:="=资料!" & st
   
10.         With Selection.Validation
    
11.             .Delete
    
12.             .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    
13.                  xlBetween, Formula1:="=二级"
    
14.         End With
    
15.     End If
    
16. End Sub

复制代码

股网千王

爱疯 发表于 2013-7-3 12:11
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim d, A, i, x
   

爱疯老师，十分感谢您的回复，我测试了一下你的代码，若点击c列就会出现“应用程序或对象定义错误”

股网千王

wp8680 发表于 2013-7-3 13:07

老师您好，我测试了你的代码，若直接点击B列就会出现1004的错误”不能取得worksheetFounction的match属性“的错误

股网千王

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim d, A, i, x
   
    If Target.Column = 1 Or Target.Column <> 2 Or Target.Count > 1 Then End
    x = Target.Offset(0, -1)
    If x = "" Then End

    A = Sheet1.Range("A1").CurrentRegion
    Set d = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(A)
        If x = A(i, 1) Then
            d(A(i, 2)) = ""
        End If
    Next i
    With Target.Validation
        .Delete
        .Add Type:=xlValidateList, Formula1:=Join(d.keys, ",")
    End With
End Sub
这是爱疯老师的代码我修改了一下，测试应该没问题。