函数vs VBA：关于城市名个数与二级下拉列表

lt0314

学习学习，做了半天虽然做处结果但觉得不简练

lt0314

这个对么

---

---

=INDEX(FREQUENCY(ROW(2:13),IF((A2:A13<>"")+(ROW(2:13)=13),ROW(2:13))),N(IF(1,ROW(2:6))))

---

Dim dic1 As Object
Sub dd()
Dim rg
Set dic1 = CreateObject("scripting.dictionary")
For i = 2 To 12
If Cells(i, 1) <> "" Then rg = Cells(i, 1).Value
dic1(rg) = dic1(rg) & "," & Cells(i, 2).Value
Next
End Sub
Private Sub Worksheet_Activate()
Call dd
    With [i3:i7].Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=Join(dic1.keys, ",")
        End With
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Column <> 9 Then Exit Sub
sss = Target.Value
If dic1 Is Nothing Then dd
With Target.Offset(, 1).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=dic1(sss)
End With
End Sub

lt0314

怎么看不到别人的

JLxiangwei

回复 兰色幻想 的帖子

1. =FREQUENCY(ROW(3:13),IF(A3:A12>0,ROW(3:12)))

复制代码

rccbjs

不知道什么，学习一下

pcxangle

何时才能达到你们的水平啊，看来我前面的路还很长

3307221980

学习学习

岁寒三友

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2. Dim arr, brr
   
3. If Target.Count > 1 Then Exit Sub
   
4. If Target.Column <> 9 And Target.Column <> 10 Then Exit Sub
   
5. n = [b65536].End(3).Row
   
6. arr = Range("a1:B" & n)
   
7. Set d = CreateObject("scripting.dictionary")
   
8. If Target.Column = 9 Then
   
9. For j = 2 To n
   
10.    If arr(j, 1) <> "" Then d(arr(j, 1)) = ""
    
11. Next j
    
12. If Target.Row < 3 Or Target.Row > d.Count + 2 Then Exit Sub
    
13. With Target.Validation
    
14.         .Delete
    
15.         .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
    
16.         Operator:=xlBetween, Formula1:=Join(d.keys, ",")
    
17.     End With
    
18.     Set d = Nothing
    
19.     Target.Offset(0, 1) = ""
    
20. ElseIf Target.Column = 10 And Target.Offset(0, -1) <> "" Then
    
21.     Set d = CreateObject("Scripting.Dictionary")
    
22.     For i = 2 To UBound(arr)
    
23.      If Target.Offset(0, -1) = arr(i, 1) Then
    
24.        For k = i To Cells(i, 1).MergeArea.Rows.Count + i - 1
    
25.          d(arr(k, 2)) = ""
    
26.        Next k
    
27.        Exit For
    
28.      End If
    
29.     Next i
    
30.     With Target.Validation
    
31.         .Delete
    
32.         .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
    
33.          Operator:=xlBetween, Formula1:=Join(d.keys, ",")
    
34.     End With
    
35.     Set d = Nothing
    
36. End If
    
37. End Sub
    
38. 
    

复制代码

醉有缘

学习学习中

yeshuangyong

这个看看，学些东西