Hsieh

¦^´_ 4# j88141
½ÒªíÂú§Î¤u§@ªí¼Ò²Õ

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. If Target.Count > 1 Then Exit Sub
   
3. Application.EnableEvents = False
   
4. k = Target.Column
   
5. r = Target.Row
   
6. w = Cells(2, k)
   
7. t = IIf(r <= 22, "¦­¤W", IIf(r > 22 And r <= 38, "¤U¤È", "±ß¤W"))
   
8. If Target<>"" And Check(w & t, Target) > 0 Then MsgBox "¸Ó±Ð®v¦¹®É¬q¤£±Æ½Ò": Target.ClearContents
   
9. Application.EnableEvents = True
   
10. End Sub
    
11. Function Check(mystr$, MyVal)
    
12. Dim Ob As Shape, A As Range, Dic As Object
    
13. Set Dic = CreateObject("Scripting.Dictionary")
    
14. With ¤u§@ªí1
    
15. For Each Ob In .Shapes
    
16.    If Ob.OLEFormat.Object.Value = 1 Then
    
17.       Set A = Ob.TopLeftCell
    
18.       w = .Cells(1, A.Column).MergeArea(1)
    
19.       t = .Cells(3, A.Column)
    
20.       Dic(w & t) = IIf(Dic(w & t) = "", .Cells(A.Row, 1), Dic(w & t) & "," & .Cells(A.Row, 1))
    
21.    End If
    
22. Next
    
23. Check = InStr(Dic(mystr), MyVal)
    
24. End With
    
25. End Function

½Æ»s¥N½X

¤U¸ü (86.08 KB)

2014-2-7 15:32