[已解决]在一个单元格中输入代码，另一单元格显示相对应的代码的下拉菜单

假绅士

如题，具体要求及说明详见表内蓝色区域。小弟在此先谢谢各位大侠，最好能用非VBA方式解决。

最佳答案

月排行榜 / 总排行榜

fjmxwrs

2013-11-26 14:37

假绅士 发表于 2013-11-26 14:30
那用代码怎么做啊？可以支持我在“名单”中后续填充数据吧？

B2的公式=IFERROR(VLOOKUP(B3,名单!A:B,2,),"")
以下代码当你选择B3时运行得到下拉

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.     Dim arr, brr(), x%, j%, str1$
   
3.     If Target.Address = "$B$3" Then
   
4.         arr = Sheets("名单").UsedRange
   
5.         str1 = Range("B1").Value
   
6.         For x = 1 To UBound(arr)
   
7.             If Mid(arr(x, 2), 7, 4) = str1 Then
   
8.                 i = i + 1
   
9.                 ReDim Preserve brr(1 To i)
   
10.                 brr(i) = arr(x, 1)
    
11.             End If
    
12.         Next x
    
13.         If i = 0 Then
    
14.             Target.Validation.Delete
    
15.             Target.Value = ""
    
16.             Exit Sub
    
17.         End If
    
18.         With Target.Validation
    
19.             .Delete
    
20.             .Add Type:=3, Formula1:=Join(brr, ",")
    
21.         End With
    
22.     End If
    
23. End Sub
    

复制代码

跳转到最佳答案楼层

蝶·舞

不用VBA的话，得用辅助区域

fjmxwrs

你个问题用VBA倒是好解决　非V复杂多了

假绅士

蝶·舞 发表于 2013-11-26 14:07
不用VBA的话，得用辅助区域

用辅助区域怎么做？

假绅士

fjmxwrs 发表于 2013-11-26 14:12
你个问题用VBA倒是好解决　非V复杂多了

那用代码怎么做啊？可以支持我在“名单”中后续填充数据吧？

fjmxwrs

假绅士 发表于 2013-11-26 14:30
那用代码怎么做啊？可以支持我在“名单”中后续填充数据吧？

B2的公式=IFERROR(VLOOKUP(B3,名单!A:B,2,),"")
以下代码当你选择B3时运行得到下拉

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.     Dim arr, brr(), x%, j%, str1$
   
3.     If Target.Address = "$B$3" Then
   
4.         arr = Sheets("名单").UsedRange
   
5.         str1 = Range("B1").Value
   
6.         For x = 1 To UBound(arr)
   
7.             If Mid(arr(x, 2), 7, 4) = str1 Then
   
8.                 i = i + 1
   
9.                 ReDim Preserve brr(1 To i)
   
10.                 brr(i) = arr(x, 1)
    
11.             End If
    
12.         Next x
    
13.         If i = 0 Then
    
14.             Target.Validation.Delete
    
15.             Target.Value = ""
    
16.             Exit Sub
    
17.         End If
    
18.         With Target.Validation
    
19.             .Delete
    
20.             .Add Type:=3, Formula1:=Join(brr, ",")
    
21.         End With
    
22.     End If
    
23. End Sub
    

复制代码

假绅士

fjmxwrs 发表于 2013-11-26 14:37
B2的公式=IFERROR(VLOOKUP(B3,名单!A:B,2,),"")
以下代码当你选择B3时运行得到下拉

如果我后续添加数据还有影响么？是否需要对代码进行改动。

假绅士

fjmxwrs 发表于 2013-11-26 14:37
B2的公式=IFERROR(VLOOKUP(B3,名单!A:B,2,),"")
以下代码当你选择B3时运行得到下拉

顺便帮忙填上代码说明吧，我好学习学习