Board logo

標題: [發問] 儲存格變動後重新計算 [打印本頁]
作者: mice    時間: 2012-11-13 23:34     標題: 儲存格變動後重新計算

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

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

如果這時候，我直接修改輸入區，因為沒有更動到選擇區的條件，所以並不會觸發執行所寫的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

  28.         Cells(i1, 8) = i7

  30.     End If
  31. 10: End Sub
複製代碼
不好意思，我很努力表達，但我知道我的表達方式很沒有章法~
先和各位先進說抱歉一下~
作者: stillfish00    時間: 2012-11-14 02:03

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

回復 2# stillfish00
阿~  抱歉 , 沒看到條件區是直接參照輸入區
作者: stillfish00    時間: 2012-11-14 02:36

回復 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

  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    時間: 2012-11-14 09:08

回復 4# stillfish00

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

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



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