返回列表 上一主題 發帖

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

mice

帖子
2 
主題
1 
精華
0 
積分
3 
點名
0  
作業系統
XP 
軟體版本
2012 
閱讀權限
10 
註冊時間
2012-11-13 
最後登錄
2015-11-10 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2012-11-13 23:34 | 只看該作者

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

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

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

說明

test1.JPG
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

  28.         Cells(i1, 8) = i7

  30.     End If
  31. 10: End Sub
複製代碼
不好意思，我很努力表達，但我知道我的表達方式很沒有章法~
先和各位先進說抱歉一下~
收藏 分享

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
2#
發表於 2012-11-14 02:03 | 只看該作者
回復 1# mice
輸入區是否能改成直接在B11~D13直接輸入 , 否則若兩邊資料不一致 , 計算時要取輸入區(B18~D20)的值還是條件區右方(B11~D13)的值?

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
3#
發表於 2012-11-14 02:06 | 只看該作者
回復 2# stillfish00
阿~  抱歉 , 沒看到條件區是直接參照輸入區

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
4#
發表於 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
複製代碼

TOP

mice

帖子
2 
主題
1 
精華
0 
積分
3 
點名
0  
作業系統
XP 
軟體版本
2012 
閱讀權限
10 
註冊時間
2012-11-13 
最後登錄
2015-11-10 
5#
發表於 2012-11-14 09:08 | 只看該作者
回復 4# stillfish00

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

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

TOP

        靜思自在 : 屋寬不如心寬。
返回列表 上一主題