Hsieh

¦^´_ 1# bridetobe
¦bÅçÃÒ©Ò¦bªº¤u§@ªí¼Ò²Õ

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. Dim Rng As Range, newitem$, newlist$
   
3. If Target.Address Like "$B$*" Then '§ïÅܪºÀx¦s®æ¬°BÄæ
   
4.     If Target(1) = "·s¼W" Then '­Y¿ï¾Ü·s¼W
   
5.     Application.EnableEvents = False 'Ãö³¬Ä²µo¨Æ¥óµ{§Ç
   
6.     newitem = InputBox("½Ð¿é¤J·s¼W¶µ¥Ø") '·s¼W¶µ¥Ø
   
7.        With ¤u§@ªí2
   
8.        .[A1].End(xlDown).Offset(1) = newitem '²M³æ©³³¡·s¼W¶µ¥Ø
   
9.        newlist = "=" & .Range(.[A1], .[A1].End(xlDown)).Address(, , , 1) '·s²M³æ¦ì§}
   
10.        End With
    
11.      Set Rng = Target.SpecialCells(xlCellTypeSameValidation) '¬Û¦PÅçÃÒÀx¦s®æ
    
12.      With Rng.Validation
    
13.      .Delete '§R°£ÅçÃÒ
    
14.      .Add xlValidateList, , , newlist '¥[¤JÅçÃÒ
    
15.      End With
    
16.       Target = newitem 'Àx¦s®æ§ï¬°·s­È
    
17.     Application.EnableEvents = True '¶}±ÒIJµo¨Æ¥óµ{§Ç
    
18.      End If
    
19. End If
    
20. End Sub

½Æ»s¥N½X

Hsieh

¦^´_ 3# bridetobe

¸Õ¸Õ¬Ý¬O§_²Å¦X?

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. Dim A As Range
   
3. If Target.Column <> 2 Then Exit Sub
   
4. With ¤u§@ªí2
   
5.   ThisWorkbook.Names.Add "²M³æ", "=OFFSET(" & .Name & "!$A$1,,,COUNTA(" & .Name & "!$A:$A))" '«Ø¥ß°ÊºA½d³ò¦WºÙ°µ¬°²M³æ
   
6.   Set A = .Cells(.Rows.Count, 1).End(xlUp).Offset(1) '²M³æ¤U¤@®æ
   
7. End With
   
8. With Target
   
9. Select Case .Value
   
10. Case "·s¼W"
    
11.    newitem = InputBox("¿é¤J·s¼W¶µ¥Ø")
    
12.    If IsError(Application.Match(newitem, [²M³æ], 0)) Then A.Value = newitem Else MsgBox newitem & "¤w¦b²M³æ¤º": Exit Sub
    
13.    With .EntireColumn.Validation
    
14.    .Delete
    
15.    .Add xlValidateList, , Formula1:="=" & [²M³æ].Address(, , , 1)
    
16.    End With
    
17.    Target = newitem
    
18. Case "§R°£"
    
19.    delitem = InputBox("¿é¤J§R°£¶µ¥Ø")
    
20.    Set A = [²M³æ].Find(delitem, lookat:=xlWhole)
    
21.    If A Is Nothing Then
    
22.       MsgBox delitem & "¥¼¦b²M³æ¤º"
    
23.       Else
    
24.       A.Delete xlShiftUp
    
25.    With .EntireColumn.Validation
    
26.    .Delete
    
27.    .Add xlValidateList, , Formula1:="=" & [²M³æ].Address(, , , 1)
    
28.    End With
    
29.    End If
    
30. End Select
    
31. End With
    
32. End Sub

½Æ»s¥N½X

Hsieh

¦^´_ 5# bridetobe

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. Dim A As Range
   
3. If Target.Column <> 2 Then Exit Sub
   
4. With ¤u§@ªí2
   
5. ThisWorkbook.Names.Add "²M³æ", "=OFFSET(" & .Name & "!$A$1,,,COUNTA(" & .Name & "!$A:$A),)"
   
6. With Range("B:B").Validation
   
7.    .Delete
   
8.    .Add xlValidateList, , , "=²M³æ"
   
9. End With
   
10. Select Case Target.Value
    
11. Case "·s¼W"
    
12. newitem = InputBox("¿é¤J·s¼W¶µ¥Ø")
    
13. If Application.CountIf([²M³æ], newitem) = 0 Then
    
14.    Set A = .Columns("A:A").Find("·s¼W", lookat:=xlWhole)
    
15.    A.Insert xlShiftDown
    
16.    A.Offset(-1) = newitem
    
17.    Target = newitem
    
18. Else
    
19.    MsgBox "¶µ¥Ø¤w¦s¦b²M³æ¤º"
    
20. End If
    
21. Case "§R°£"
    
22. delitem = InputBox("¿é¤J§R°£¶µ¥Ø")
    
23. Set A = .Columns("A:A").Find(delitem, lookat:=xlWhole)
    
24. If A Is Nothing Then
    
25.    MsgBox delitem & "¤£¦s¦b²M³æ¤º"
    
26.    Else
    
27.    A.Delete xlShiftUp
    
28. End If
    
29. Case "­×§ï"
    
30. chitem = InputBox("¿é¤J­×§ï¶µ¥Ø")
    
31. Set A = .Columns("A:A").Find(chitem, lookat:=xlWhole)
    
32. If A Is Nothing Then
    
33.    MsgBox chitem & "¤£¦s¦b²M³æ¤º"
    
34.    Else
    
35.    A.Value = InputBox("¿é¤J§ó¥¿¶µ¥Ø", , chitem)
    
36.    Target = A
    
37. End If
    
38. End Select
    
39. End With
    
40. With Range("B:B").Validation
    
41.    .Modify xlValidateList, , , "=²M³æ"
    
42. End With
    
43. End Sub

½Æ»s¥N½X