Hsieh

¦^´_ 3# bridetobe

¤£·|¦³³o¼Ë±¡§Î¤~¹ï¡A¤W¶ÇÀɮרӬݬÝ

Hsieh

¦^´_ 5# bridetobe

·|¦Û°Ê§ó·s¤X!§A«ç»ò¾Þ§@ªº?

   

¤U¸ü (375.4 KB)

2014-7-9 10:11

Hsieh

¦^´_ 7# bridetobe
­n§ó§ï¤w¸g¿é¤J¤º®e´N¥²¶·­«·s¼g¤J

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. Dim A As Range
   
3. If Target.Column <> 2 Then Exit Sub
   
4. With Sheet3
   
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.    Range("B:B").Replace chitem, A  'BÄæ©Ò¦³¤w¸g¿é¤Jªº¸ê®Æ¤@°_´À´«
    
38. End If
    
39. End Select
    
40. End With
    
41. With Range("B:B").Validation
    
42.    .Modify xlValidateList, , , "=²M³æ"
    
43. End With
    
44. End Sub

½Æ»s¥N½X