返回列表 上一主題 發帖

[發問] worksheet 事件導致無法複製貼上

s13030029
　暱稱: 伊恩

中學生Rank: 2

帖子
97 
主題
33 
精華
0 
積分
129 
點名
0  
作業系統
Win 7 
軟體版本
office 2007 
閱讀權限
20 
性別
男 
註冊時間
2019-5-7 
最後登錄
2022-8-25 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 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

  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
複製代碼
test1.rar (15.14 KB)
收藏 分享

s13030029
　暱稱: 伊恩

中學生Rank: 2

帖子
97 
主題
33 
精華
0 
積分
129 
點名
0  
作業系統
Win 7 
軟體版本
office 2007 
閱讀權限
20 
性別
男 
註冊時間
2019-5-7 
最後登錄
2022-8-25 
2#
發表於 2019-11-19 15:58 | 只看該作者
版本是 excel 2007

TOP

s13030029
　暱稱: 伊恩

中學生Rank: 2

帖子
97 
主題
33 
精華
0 
積分
129 
點名
0  
作業系統
Win 7 
軟體版本
office 2007 
閱讀權限
20 
性別
男 
註冊時間
2019-5-7 
最後登錄
2022-8-25 
3#
發表於 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

  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
複製代碼

TOP

        靜思自在 : 有多少力量就做多少事，不要心存等待，等待才會落空。
返回列表 上一主題