[發問] 儲存格變動後重新計算 重新計算

mice

各位先進大家好...
最近剛開始接觸VBA~還請各位多多指教~
檔案位置 (SKYDRIVE空間) : http://sdrv.ms/Sjl8e7

這EXCEL主要有三個區域，分別是輸入區、選擇(條件)區、結果區
正常情況下，將資料輸入於輸入區後再去選擇(條件)區，透過VBA，便會產生結果於結果區…

下載 (93.01 KB)
說明

2012-11-13 23:18

如果這時候，我直接修改輸入區，因為沒有更動到選擇區的條件，所以並不會觸發執行所寫的VBA，自然也不會更改到結果區的結果

所以我想問，是否有範例可以參考，當我在輸入區直接輸入資料時(黃色區域)，在不重新點選選擇區(紅色區域)的情況下，結果區(藍色區域)會重新計算。

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. On Error GoTo 10
   
3.     Dim i1, i2, i3, i4, i5, i6, i7 As Currency
   
4.     Dim var As Integer
   
5.     If Left(Target.Address, 2) = "$A" Then  '選擇A行，為選擇區
   
6.   
   
7.         '選擇區的條件(1~3)
   
8.         Dim funCont As String
   
9.         funCont = Trim(CStr(Target.Value))
   
10.         Select Case funCont
    
11.             Case "條件1"
    
12.             var = 1
    
13.             Case "條件2"
    
14.             var = 2
    
15.             Case "條件3"
    
16.             var = 3
    
17.         End Select
    
18.         '根劇選擇區的條件 輸出至結果區
    
19.         i1 = Range(Target.Address).Row
    
20.         i2 = Cells(i1, 2)
    
21.         i3 = Cells(i1, 3)
    
22.         i4 = Cells(i1, 4)
    
23.         i7 = (i2 * Cells(var + 1, 6) + i3 * Cells(var + 1, 8) + i4 - Cells(var + 1, 7))
    
24.         If i7 < 0 Then
    
25.             i7 = 0
    
26.         End If
    
27. 
    
28.         Cells(i1, 8) = i7
    
29. 
    
30.     End If
    
31. 10: End Sub

複製代碼

不好意思，我很努力表達，但我知道我的表達方式很沒有章法~
先和各位先進說抱歉一下~

stillfish00

回復 1# mice
輸入區是否能改成直接在B11~D13直接輸入 , 否則若兩邊資料不一致 , 計算時要取輸入區(B18~D20)的值還是條件區右方(B11~D13)的值?

stillfish00

回復 2# stillfish00
阿~  抱歉 , 沒看到條件區是直接參照輸入區

stillfish00

回復 1# mice
依你的寫法稍作修改

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. On Error GoTo 10
   
3.     Dim i1, i2, i3, i4, i5, i6, i7 As Currency
   
4.     Dim var As Integer
   
5.     If Left(Target.Address, 2) = "$A" Then
   
6.         
   
7.         Dim funCont As String
   
8.         funCont = Trim(CStr(Target.Value))
   
9.    
   
10.         Select Case funCont
    
11.             Case "條件1"
    
12.             var = 1
    
13.             Case "條件2"
    
14.             var = 2
    
15.             Case "條件3"
    
16.             var = 3
    
17.         End Select
    
18.    
    
19.         i1 = Range(Target.Address).Row
    
20.         i2 = Cells(i1, 2)
    
21.         i3 = Cells(i1, 3)
    
22.         i4 = Cells(i1, 4)
    
23.         i7 = (i2 * Cells(var + 1, 6) + i3 * Cells(var + 1, 8) + i4 - Cells(var + 1, 7))
    
24.         If i7 < 0 Then
    
25.             i7 = 0
    
26.         End If
    
27. 
    
28.         Cells(i1, 8) = i7
    
29.     End If
    
30.         
    
31.     '輸入區
    
32.     If Application.Intersect(Target, Range("B18:D20")) Then
    
33.         For Each result In Range("H11:H13")
    
34.             funCont = Trim(CStr(Range("A" & result.Row).Value))
    
35.             
    
36.             Select Case funCont
    
37.                 Case "條件1"
    
38.                 var = 1
    
39.                 Case "條件2"
    
40.                 var = 2
    
41.                 Case "條件3"
    
42.                 var = 3
    
43.             End Select
    
44.             
    
45.             i1 = result.Row   '改為result.row
    
46.             i2 = Cells(i1, 2)
    
47.             i3 = Cells(i1, 3)
    
48.             i4 = Cells(i1, 4)
    
49.             i7 = (i2 * Cells(var + 1, 6) + i3 * Cells(var + 1, 8) + i4 - Cells(var + 1, 7))
    
50.             If i7 < 0 Then
    
51.                 i7 = 0
    
52.             End If
    
53.             
    
54.             Cells(i1, 8) = i7
    
55.         Next
    
56.     End If
    
57.    
    
58. 10: End Sub

複製代碼

mice

回復 4# stillfish00

！！！
stillfish00 謝謝您~ 可以WORK了~
這問題我爬了2天的文，自己用了好多別人的範例來試都不行...>"<
最後才忍不住來問...

讓我先瞭解一下您的程式，再次感謝您~ 謝謝！