ikboy

Dim d As Object, k, t, s$

1. Private Sub Worksheet_Activate()
   
2. If d Is Nothing Then dic
   
3. End Sub

½Æ»s¥N½X

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. Application.EnableEvents = 0
   
3. Set td = Application.Intersect([b1:b3], Target)
   
4. If Not td Is Nothing Then
   
5.     If Len(td.Value) Then
   
6.         k = td.Value: [b1:b3] = "": td.Value = k
   
7.         a = Array("CD#", "DC#", "CO#")
   
8.         k = a(td.Row - 1) & td.Value
   
9.         ar = Sheets("¸ê®Æ®w").[a1].CurrentRegion.Value
   
10.         If d Is Nothing Then dic
    
11.         t = Split(d(k), "|")
    
12.         ReDim b(1 To UBound(t), 1 To UBound(ar, 2))
    
13.         For i = 1 To UBound(t)
    
14.             b(i, 1) = i
    
15.             For j = 2 To UBound(ar, 2)
    
16.                 b(i, j) = ar(t(i), j)
    
17.             Next
    
18.         Next
    
19.         [a5].CurrentRegion.Offset(4).Clear
    
20.         [a5].Resize(i - 1, j - 1) = b
    
21.     End If
    
22. End If
    
23. Application.EnableEvents = 1
    
24. End Sub

½Æ»s¥N½X

1. Sub dic()
   
2. Set d = CreateObject("scripting.dictionary")
   
3. ar = Sheets("¸ê®Æ®w").[a1].CurrentRegion.Value
   
4. For i = 2 To UBound(ar)
   
5.     d("CO#" & ar(i, 4)) = d("CO#" & ar(i, 4)) & "|" & i
   
6.     d("CD#" & ar(i, 6)) = d("CD#" & ar(i, 6)) & "|" & i
   
7.     d("DC#" & ar(i, 7)) = d("DC#" & ar(i, 7)) & "|" & i
   
8. Next
   
9. For Each t In Array("CD#", "DC#", "CO#")
   
10.     k = Filter(d.keys, t): s = ""
    
11.     For i = 0 To UBound(k)
    
12.         k(i) = Replace(k(i), t, "")
    
13.     Next
    
14.     For i = 0 To UBound(k) - 1
    
15.         For j = i + 1 To UBound(k)
    
16.             If k(j) < k(i) Then t = k(i): k(i) = k(j): k(j) = t
    
17.         Next
    
18.     Next
    
19.     n = n + 1
    
20.     With Range("b" & n).Validation
    
21.         .Delete
    
22.         .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    
23.         xlBetween, Formula1:=Join(k, ",")
    
24.     End With
    
25. Next
    
26. End Sub

½Æ»s¥N½X

ikboy

¥[¤@¥yAntoFilter¤£¬O§ó¦n§@ÃöÁp¶Ü¡C

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. Application.EnableEvents = 0
   
3. Dim td As Range, a, ar, i&, j&
   
4. Set td = Application.Intersect([b1:b3], Target)
   
5. If Not td Is Nothing Then
   
6.     If Len(td.Value) Then
   
7.         k = td.Value: [b1:b3] = "": td.Value = k
   
8.         a = Array("CD#", "DC#", "CO#")
   
9.         k = a(td.Row - 1) & td.Value
   
10.         ar = Sheets("Data").[a1].CurrentRegion.Value
    
11.         If d Is Nothing Then dic
    
12.         t = Split(d(k), "|")
    
13.         ReDim b(1 To UBound(t), 1 To UBound(ar, 2))
    
14.         For i = 1 To UBound(t)
    
15.             b(i, 1) = i
    
16.             For j = 2 To UBound(ar, 2)
    
17.                 b(i, j) = ar(t(i), j)
    
18.             Next
    
19.         Next
    
20.         [a5].CurrentRegion.Offset(4).Clear
    
21.         [a5].Resize(i - 1, j - 1) = b
    
22.         [color=Red][a4:j4].AutoFilter[/color]
    
23.     End If
    
24. End If
    
25. Application.EnableEvents = 1
    
26. End Sub

½Æ»s¥N½X