返回列表 上一主題 發帖

[發問] 這個可以使用IF公式嗎?

回復 10# appr

工作表模組
  1. Private Sub worksheet_change(ByVal target As Range)
  2. Set RngA = Range("A2:A4")
  3. Set RngB = Range("B2:B4")
  4. Set RngCA = Intersect(target, RngA)
  5. Set RngCS = Intersect(target, RngB)
  6. If Not RngCA Is Nothing Then
  7.    RngCA.Offset(0, 2) = RngCA.Offset(0, 2) + RngCA.Value
  8.    RngCA.Value = ""
  9. End If
  10. If Not RngCS Is Nothing Then
  11.    RngCS.Offset(0, 1) = RngCS.Offset(0, 1) - RngCS.Value
  12.    RngCS.Value = ""
  13. End If
  14. If target.Address = "$D$2" Then
  15.    Range("E2") = Range("D2")
  16. End If
  17. If target.Address = "$E$2" Then
  18.    Range("D2") = Range("E2")
  19. End If
  20. End Sub
複製代碼

TOP

回復 11# register313


    謝謝R大的回覆

所以應該是直接接下去而不是先接Private Sub worksheet_change(ByVal target As Range):'(

那如果從第14項開始我要增加成複數的儲存格

是要像第17項的方式下去 , 去做 複製貼上 然後更改成我要的儲存格

那這樣的話,如果太多會不會因此,有時會發生錯誤?

還是說我想太多???

TOP

回復 12# appr
  1. Private Sub worksheet_change(ByVal target As Range)
  2. Set RngA = Range("A2:A4")
  3. Set RngB = Range("B2:B4")
  4. Set RngCA = Intersect(target, RngA)
  5. Set RngCS = Intersect(target, RngB)
  6. If Not RngCA Is Nothing Then
  7.    RngCA.Offset(0, 2) = RngCA.Offset(0, 2) + RngCA.Value
  8.    RngCA.Value = ""
  9. End If
  10. If Not RngCS Is Nothing Then
  11.    RngCS.Offset(0, 1) = RngCS.Offset(0, 1) - RngCS.Value
  12.    RngCS.Value = ""
  13. End If
  14. Set RngD = Range("D2:D4")
  15. Set RngE = Range("E2:E4")
  16. Set RngDE = Intersect(target, RngD)
  17. Set RngED = Intersect(target, RngE)
  18. If Not RngDE Is Nothing Then          'E2~E4=D2~D4
  19.    RngE.Value = RngD.Value
  20. End If
  21. If Not RngED Is Nothing Then          'D2~D4=E2~E4
  22.    RngD.Value = RngE.Value
  23. End If
  24. End Sub
複製代碼

TOP

本帖最後由 appr 於 2012-2-24 22:07 編輯

回復 13# register313


謝謝r大的分享,我已經大概都清楚了!!!只是本於好奇的想法,想再多問幾個問題

那如果是無論是第2,3 項 或是  14,15 項  以及18,20項
  1. Private Sub worksheet_change(ByVal target As Range)
  2. Set RngA = Range("A2:A4")
  3. Set RngB = Range("B2:B4")
  4. Set RngCA = Intersect(target, RngA)
  5. Set RngCS = Intersect(target, RngB)
  6. If Not RngCA Is Nothing Then
  7.    RngCA.Offset(0, 2) = RngCA.Offset(0, 2) + RngCA.Value
  8.    RngCA.Value = ""
  9. End If
  10. If Not RngCS Is Nothing Then
  11.    RngCS.Offset(0, 1) = RngCS.Offset(0, 1) - RngCS.Value
  12.    RngCS.Value = ""
  13. End If
  14. Set RngD = Range("D2:D4")
  15. Set RngE = Range("E2:E4")
  16. Set RngDE = Intersect(target, RngD)
  17. Set RngED = Intersect(target, RngE)
  18. If Not RngDE Is Nothing Then          'E2~E4=D2~D4
  19. RngE.Value = RngD.Value
  20. End If
  21. If Not RngED Is Nothing Then          'D2~D4=E2~E4
  22. RngD.Value = RngE.Value
  23. End If
  24. End Sub
複製代碼
這些都是屬於連接的, 那如果是用跳的一項 ﹝A2,A4,A6﹞的是要怎麼做???

第二個是這整個程式碼 是以 A2的儲存格 加上 數字 等於 C2的 數字合
                                        以及B2的儲存格  減上 數字 等於 C2的數字合   

那麼如果我要把B2的儲存格換成C2

那麼 這個程式碼 所出來的結果會在D2:D4顯示

不過A2會變成【 -】號         而我更動的  C2 也是【 -】號     所以出來的答案會都是負的  

那我應該是要怎麼做會比較更動會比較好?

另外如果我是想要指定一個儲存格 ,我自己有做一個更動 , 雖然我知道一定是錯的,但還是希望各位過目看看
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2. Set RngA = Range("A2:A4")
  3. Set RngB = Range("B2:B4")
  4. Set RngC = Range("G2:G4")
  5. Set RngCA = Intersect(Target, RngA)
  6. Set RngCS = Intersect(Target, RngB)
  7. Set RngCD = Intersect(Target, RngC)
  8. If Not RngCA Is Nothing Then
  9.    RngCD.Offset(0, 2) = RngCA.Offset(0, 2) + RngCA.Value
  10.    RngCA.Value = ""
  11. End If
  12. If Not RngCS Is Nothing Then
  13.    RngCD.Offset(0, 1) = RngCS.Offset(0, 1) - RngCS.Value
  14.    RngCS.Value = ""
  15. End If
  16. End Sub
複製代碼

TOP

回復 14# appr


問題一   Set RNG = Union([A2], [A4], [A6])
問題二   不了解說明及功能
問題三    不了解說明及功能

TOP

本帖最後由 appr 於 2012-2-24 23:42 編輯

回復 15# register313

先回答三,在回答二

   問題三的說明:原本這個程式碼下是 C2 為最後答案 ,也就是說 A2 若為10     那 C2為8   
                                                                                                                      B2 若為 2

那麼如果要更改C2的儲存格到 G2  該如何怎麼寫起

功能說明: 變動最後答案儲存格

附註:最後的程式碼是我自己照著上面的想法,去試著去打出來的!!

只是看不確定是否正確,想讓大家看看錯在哪?

延續問題3

問題二的說明:    如果把B2 的儲存格變動 到 C2   因 問題3的程式碼的設定為  往後推一個儲存格為答案,故      

若  A2 為   4           D2 為   3
     C2 為   1   

但我試著照上面更動後 卻發現    A2為4的情況下      D2為   -4
                  
                                                    若更動後的C2輸入 4   那   D2 為  -4

功能:變動中間的儲存格

TOP

回復 16# appr

問題3
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2. Set RngA = Range("A2:A4")
  3. Set RngB = Range("B2:B4")
  4. Set RngCA = Intersect(Target, RngA)
  5. Set RngCS = Intersect(Target, RngB)
  6. If Not RngCA Is Nothing Then
  7.    RngCA.Offset(0, 6) = RngCA.Offset(0, 6) + RngCA.Value
  8.    RngCA.Value = ""
  9. End If
  10. If Not RngCS Is Nothing Then
  11.    RngCS.Offset(0, 5) = RngCS.Offset(0, 5) - RngCS.Value
  12.    RngCS.Value = ""
  13. End If
  14. End Sub
複製代碼

TOP

回復 17# register313


    了解!!我這兩個問題是出在哪裡了!!!感謝R大的回覆耶!!

TOP

回復 17# register313

不好意思,又出現在了兩個問題想請教一下, 我想要同時讓A2跟著C2以及G2做一樣的動作!!

但每次用好後 ,我的excel就當掉了!!!是程式碼我打錯了嗎?

以及如果想讓 G2可以是自動判別月份 !!!  也就是說 2月份是在G2 當 3月份會自動跳到  H2 這是要怎麼設定????
  1. Private Sub worksheet_change(ByVal target As Range)
  2. Set RngA = Range("A2:A4")
  3. Set RngB = Range("B2:B4")
  4. Set RngCA = Intersect(target, RngA)
  5. Set RngCS = Intersect(target, RngB)
  6. If Not RngCA Is Nothing Then
  7.    RngCA.Offset(0, 2) = RngCA.Offset(0, 2) + RngCA.Value
  8.    RngCA.Value = ""
  9. End If
  10. If Not RngCS Is Nothing Then
  11.    RngCS.Offset(0, 1) = RngCS.Offset(0, 1) - RngCS.Value
  12.    RngCS.Value = ""
  13. End If
  14. Set RngD = Range("D2:D4")
  15. Set RngE = Range("E2:E4")
  16. Set RngDE = Intersect(target, RngD)
  17. Set RngED = Intersect(target, RngE)
  18. If Not RngDE Is Nothing Then          'E2~E4=D2~D4
  19.    RngE.Value = RngD.Value
  20. End If
  21. If Not RngED Is Nothing Then          'D2~D4=E2~E4
  22.    RngD.Value = RngE.Value
  23. End If
  24. Set RngA = Range("A2:A4")
  25. Set RngCA = Intersect(target, RngA)
  26. If Not RngCA Is Nothing Then
  27.    RngCA.Offset(0, 6) = RngCA.Offset(0, 6) + RngCA.Value
  28.    RngCA.Value = ""
  29. End If
  30. End Sub
複製代碼

TOP

本帖最後由 register313 於 2012-2-27 10:14 編輯

回復 19# appr

目前功能如下
1.gif
  1. Private Sub worksheet_change(ByVal target As Range)
  2. Set RngA = Range("A2:A4")
  3. Set RngB = Range("B2:B4")
  4. Set RngCA = Intersect(target, RngA)
  5. Set RngCS = Intersect(target, RngB)
  6. If Not RngCA Is Nothing Then
  7.    RngCA.Offset(0, 2) = RngCA.Offset(0, 2) + RngCA.Value
  8.    RngCA.Offset(0, 6) = RngCA.Offset(0, 6) + RngCA.Value
  9.    RngCA.Value = ""
  10. End If
  11. If Not RngCS Is Nothing Then
  12.    RngCS.Offset(0, 1) = RngCS.Offset(0, 1) - RngCS.Value
  13.    RngCS.Value = ""
  14. End If
  15. Set RngD = Range("D2:D4")
  16. Set RngE = Range("E2:E4")
  17. Set RngDE = Intersect(target, RngD)
  18. Set RngED = Intersect(target, RngE)
  19. If Not RngDE Is Nothing Then          'E2~E4=D2~D4
  20.    RngE.Value = RngD.Value
  21. End If
  22. If Not RngED Is Nothing Then          'D2~D4=E2~E4
  23.    RngD.Value = RngE.Value
  24. End If
  25. End Sub
複製代碼
其餘問題以excel檔案作成範例再加以說明

TOP

        靜思自在 : 話多不如話少,話少不如話好。
返回列表 上一主題