ikboy

1. Dim d As Object

½Æ»s¥N½X

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. Dim rng As Range, s$, k, t, xd As Object, i&, j&
   
3. If Target.Cells.Count > 1 Then Exit Sub
   
4. Set rng = [i2:l2]
   
5. If Application.Intersect(rng, Target) Is Nothing Then Exit Sub
   
6. If Target = rng(rng.Cells.Count) Then Exit Sub
   
7. If d Is Nothing Then Call zz: Exit Sub
   
8. Set xd = CreateObject("scripting.dictionary")
   
9. For j = 1 To rng.Cells.Count
   
10.      s = s & rng(j).Value & "|"
    
11.     If Target = rng(j) Then Exit For
    
12. Next
    
13. 1000
    
14. k = Filter(d.keys, s)
    
15. For Each t In k
    
16.     xd(Split(t, "|")(j)) = ""
    
17. Next
    
18. t = Join(xd.keys, ",")
    
19. If t = "" Then s = s & "|": j = j + 1: rng(j).Validation.Delete: GoTo 1000
    
20. With rng(j + 1).Validation
    
21.     .Delete
    
22.     .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    
23.     xlBetween, Formula1:=t
    
24. End With
    
25. Application.EnableEvents = 0
    
26. i = InStr(t, ",")
    
27. Select Case i
    
28.     Case 0: rng(j + 1) = t
    
29.     Case 1: rng(j + 1) = Mid(t, 2)
    
30.     Case Else: rng(j + 1) = ""
    
31. End Select
    
32. rng(j + 1).Select
    
33. Application.EnableEvents = 1
    
34. End Sub

½Æ»s¥N½X

1. Sub zz()
   
2. Set d = CreateObject("scripting.dictionary")
   
3. Dim a, b(), s$, k
   
4. a = [a1].CurrentRegion.Value
   
5. ReDim b(UBound(a, 2) - 1)
   
6. For i = 2 To UBound(a)
   
7.     d(a(i, 1)) = ""
   
8.     For j = 1 To UBound(a, 2)
   
9.         b(j - 1) = a(i, j)
   
10.     Next
    
11.     d(Join(b, "|")) = ""
    
12. Next
    
13. s = Join(Filter(d.keys, "|", False), ",")
    
14. With [i2].Validation
    
15.     .Delete
    
16.     .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    
17.     xlBetween, Formula1:=s
    
18. End With
    
19. Application.ScreenUpdating = 0
    
20. Application.EnableEvents = 0
    
21. [i2:l2] = ""
    
22. Application.ScreenUpdating = 1
    
23. Application.EnableEvents = 1
    
24. MsgBox "Please select item form " & [i1].Value & " first"
    
25. [i2].Select
    
26. End Sub

½Æ»s¥N½X