[已解决]数据有效性的代码求助大神帮助

913852310

在sheet1的A5~A15中的对象作为下拉菜单的选项当sheet1中F20=1时，在sheet3的e3单元格显示下拉菜单

当sheet1中F20不为1时，在sheet3的e3单元格为sheet1中B20

最佳答案

月排行榜 / 总排行榜

大灰狼1976

2017-10-27 16:42

见附件，更改sheet1的F20单元格后生效。

跳转到最佳答案楼层

大灰狼1976

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. If Target.Count > 1 Then Exit Sub
   
3. If Target.Address <> [f20].Address Then Exit Sub
   
4. With Sheets(2).[e3].Validation
   
5.   .Delete
   
6.   If Target = 1 Then
   
7.     Dim arr, s$, i&
   
8.     arr = [a5].CurrentRegion
   
9.     For i = 1 To UBound(arr)
   
10.       s = s & "," & arr(i, 1)
    
11.     Next i
    
12.     .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Mid(s, 2)
    
13.   Else
    
14.     Sheets(2).[e3] = [b20]
    
15.   End If
    
16. End With
    
17. End Sub

复制代码

913852310

大灰狼1976 发表于 2017-10-27 16:25

大神，怎么我没有调试出来？传个附件给我吧，我是小白

大灰狼1976

见附件，更改sheet1的F20单元格后生效。

913852310

大灰狼1976 发表于 2017-10-27 16:42
见附件，更改sheet1的F20单元格后生效。

OK了，大神，谢谢你了！十分感谢

913852310

大灰狼1976 发表于 2017-10-27 16:42
见附件，更改sheet1的F20单元格后生效。

大神，怎么限制一下。下拉菜单只在A5~A15中选，还有一个问题就是：当f20是从其他单元格引用的时候，每次要点一下f20单元格才能实现，能不能点sheet3中的e3就启动一次？

大灰狼1976

可以实现的，见附件。
不过有点小问题，选择E3单元格时，删不掉原来的数据有效性列表，所以用了变通的方法。

913852310

大灰狼1976 发表于 2017-10-28 09:17
可以实现的，见附件。
不过有点小问题，选择E3单元格时，删不掉原来的数据有效性列表，所以用了变通的方法 ...

大神，A5~A15怎么才能限定呢？就是当A5上面有值的时候也会录入到下拉菜单中，A1~A20有值的时候全都会录入到下拉菜单中。我只想在A5到A15中选

大灰狼1976

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2. If Target.Count > 1 Then Exit Sub
   
3. If Target.Address <> [e3].Address Then Exit Sub
   
4. With Target.Validation
   
5.   .Delete
   
6.   If Sheets(1).[f20] = 1 Then
   
7.     Dim arr, s$, i&
   
8.     arr = Sheets(1).[a5:a15]
   
9.     For i = 1 To UBound(arr)
   
10.       If arr(i, 1) = "" Then Exit For
    
11.       s = s & "," & arr(i, 1)
    
12.     Next i
    
13.     Target = ""
    
14.     .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Mid(s, 2)
    
15.   Else
    
16.     Target = Sheets(1).[b20]
    
17.     .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Target
    
18.   End If
    
19. End With
    
20. End Sub

复制代码

913852310

大灰狼1976 发表于 2017-10-28 11:31

非常感谢大神，完全满足我的要求！谢谢