標題: [發問] worksheet 事件導致無法複製貼上 [打印本頁]

---

作者: s13030029    時間: 2019-11-19 15:05     標題: worksheet 事件導致無法複製貼上

我的2個工作表都有如下一樣的程式碼，不知道是哪裡有問題導致我要在兩個工作表之間無法進行複製貼上，我有把程式註解掉試，結果是可以複製貼上的
不知道有沒有人知道是哪裡出了問題???
我也有查到Application.EnableEvents = False，Application.EnableEvents = True，的用法，但會變成我的程式碼沒辦法用。
希望有高手能幫幫忙@@

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.     If Target Is Nothing Then Exit Sub
   
3.     If Target.Count > 1 Then Exit Sub
   
4.     If [A37].Value <> "" Then
   
5.         Range("C39").Value = Range("C3").Value
   
6.         Range("I39").Value = Range("I3").Value
   
7.         Range("C42").Value = Range("C6").Value
   
8.         Range("C43").Value = Range("C7").Value
   
9.         Range("I41").Value = Range("I5").Value
   
10.         Range("I42").Value = Range("I6").Value
    
11.         Range("I43").Value = Range("I7").Value
    
12.         Range("I44").Value = Range("I8").Value
    
13.         Range("C72").Value = Range("C36").Value
    
14.         Range("B69").Value = Range("B33").Value
    
15.     End If
    
16.     If [F11] = "" Then Exit Sub
    
17.     If [F11] <> "" Then Application.MoveAfterReturnDirection = xlToRight
    
18.     If Target.Column = 11 Then Target(2, -4).Select
    
19. End Sub
    
20. 
    
21. Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    
22.     Dim SelRng As Range
    
23.     Set SelRng = Application.Intersect([F11:J31,F47:J67], Target)
    
24.     If SelRng Is Nothing Then Exit Sub
    
25.         If SelRng.Count > 1 Then Exit Sub
    
26.         If SelRng & "" = "0" Then
    
27.            SelRng = "OK"
    
28.         ElseIf SelRng & "" = "." Then
    
29.            SelRng = "N/A"
    
30.         End If
    
31. End Sub

複製代碼

[attach]31426[/attach]

---

作者: s13030029    時間: 2019-11-19 15:58

版本是 excel 2007

---

作者: s13030029    時間: 2019-11-19 16:58

已解決~~
'   Application.EnableEvents = False  停止觸發事件
'   Application.EnableEvents = True   重新啟動事件

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.     Dim Sel As Range
   
3.     Set Sel = Application.Intersect([K:K], Target)
   
4.     If Sel Is Nothing Then GoTo ena
   
5.     If Sel.Count > 1 Then GoTo ena
   
6.     If [A37].Value <> "" Then
   
7.         Range("C39").Value = Range("C3").Value
   
8.         Range("I39").Value = Range("I3").Value
   
9.         Range("C42").Value = Range("C6").Value
   
10.         Range("C43").Value = Range("C7").Value
    
11.         Range("I41").Value = Range("I5").Value
    
12.         Range("I42").Value = Range("I6").Value
    
13.         Range("I43").Value = Range("I7").Value
    
14.         Range("I44").Value = Range("I8").Value
    
15.         Range("C72").Value = Range("C36").Value
    
16.         Range("B69").Value = Range("B33").Value
    
17.     End If
    
18.     If [F11] = "" Then Exit Sub
    
19.     If [F11] <> "" Then Application.MoveAfterReturnDirection = xlToRight
    
20.     If Sel.Column = 11 Then
    
21.         Application.EnableEvents = False
    
22.         Target(2, -4).Select
    
23.     End If
    
24. ena:
    
25.     Application.EnableEvents = True
    
26. End Sub
    
27. 
    
28. Private Sub Worksheet_Change(ByVal Target As Range)
    
29.     Dim SelRng As Range
    
30.     Set SelRng = Application.Intersect([F11:J31,F47:J67], Target)
    
31.     If SelRng Is Nothing Then GoTo en
    
32.     If SelRng.Count > 1 Then GoTo en
    
33.     If SelRng & "" = "0" Then
    
34.        SelRng = "OK"
    
35.     ElseIf SelRng & "" = "." Then
    
36.        SelRng = "N/A"
    
37.     End If
    
38. en:
    
39.     Application.EnableEvents = True
    
40. End Sub

複製代碼

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)