如何改變觸發方式

lucky12345

Private Sub Worksheet_Calculate()
Application.EnableEvents = False
    If UCase([b20001]) = "K" Then
         [g19000:H20000] = [ g19001:H20001].Value
    End If
If [b20005] >= 22 Then [g1:H19000] = ""
    Application.EnableEvents = True
End Sub
以上程式碼目前使用中.......
現在我有個新的需求.......要改變b20001的觸發方式
當b20001>=1     [g19000:H20000] = [ g19001:H20001].Value   複製一次
當b20001>=2 只要數字改變 [g19000:H20000] = [ g19001:H20001].Value   複製一次
當b20001>=3  只要數字改變.................................................................    複製一次
ps當b20001=文字就不能觸發)
請問各位大大  以上程式瑪可否修改？  謝謝您的指導

Hsieh

1. Private Sub Worksheet_Calculate()
   
2. Application.EnableEvents = False
   
3.     If IsNumeric([b20001]) Then
   
4.          [g19000:H20000] = [ g19001:H20001].Value
   
5.        ElseIf [b20005] >= 22 Then
   
6.        [g1:H19000] = ""
   
7.      End If
   
8.     Application.EnableEvents = True
   
9. End Sub

複製代碼

是否是這樣的意思?

lucky12345

可以了
謝謝版主指導

lucky12345

Hsieh 謝謝您不吝指導
您所提供的程式碼.......我再三的測試 ,發現與我的需求.有一點差異
是觸發位置問題.....如下
我的需求,只允許b20001>=1...條件之下.....只b20001數值改變一次,就允許觸發一次
但是您提供的程式碼只要在任一儲存格打入=1+1按enter.......也會觸發一次
不知如何解決？........再三麻煩您  真是謝謝您

GBKEE

回復 4# lucky12345

改用 Worksheet_Change 事件 試試看

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     Application.EnableEvents = False
   
3.     If Target.Address(0, 0) = "B20001" And Target > 1 Then [g19000:H20000] = [ g19001:H20001].Value
   
4.     If Target.Address(0, 0) = "B20005" And Target >= 22 Then [g1:H19000] = ""
   
5.     Application.EnableEvents = True
   
6. End Sub

複製代碼

lucky12345

謝謝各位大大幫忙
不知為何只試用成功一次  請幫我查看附檔 謝謝
哇！不能上傳耶！

GBKEE

回復 6# lucky12345
上傳檔案 只接受下列的副檔名  chm, pdf, zip, rar, tar, gz, bzip2, gif, jpg, jpeg, png  
如不是上列 的檔案需壓縮 為 zip, rar 的壓縮檔上傳

lucky12345

謝謝各位大大幫忙
寄上附檔   請幫我查看 謝謝

GBKEE

回復 8# lucky12345
附檔 的B208 >=22   B205是空白的

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     Application.EnableEvents = False
   
3.     If Not Intersect(Target, Range("B201", "B205")) Is Nothing Then
   
4.         If [B201] > 1 Then [g190:H200] = [ g191:H201].Value
   
5.         If [B205] >= 22 Then [g1:H190] = ""
   
6.     End If
   
7.     Application.EnableEvents = True
   
8. End Sub

複製代碼

oobird

若你曾經出現錯誤而讓程式中途跳出的話，你必須單獨執行這一句：
Application.EnableEvents = True