計算後自動刪除

帖子: 2848
主題: 10
精華: 0
積分: 2903
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2026-7-25

11^# 跳轉到 »

發表於 2023-2-17 10:48 | 只看該作者

Private Sub Worksheet_Change(ByVal Target As Range)
With Target
   If .Count > 1 Or .Item(1) = "" Then Exit Sub
   If Not Intersect(Range("a3:c3"), .Cells) Is Nothing Then
      .Cells(-1, 1) = Val(.Cells(-1, 1)) + Val(.Value)
      .ClearContents
   End If
End With
End Sub

A3:C3 >> A1:C1

TOP

Andy2483

　暱稱: 厚臉皮的學生

碩士班 Rank: 5 Rank: 5

帖子: 1567
主題: 40
精華: 0
積分: 1591
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 100
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2026-2-2

12^#

發表於 2023-2-17 11:13 | 只看該作者

本帖最後由 Andy2483 於 2023-2-17 11:21 編輯

回復 11# 准提部林
回復 11# coafort

謝謝前輩指導
1.後學在此主題沒有應用 http://forum.twbts.com/thread-23842-1-1.html 心得經驗,謝謝前輩指導
2.防止連續觸發不是只怕再觸發,也要懂得找出口,謝謝前輩
學習心得註解如下,請再指導,謝謝

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
'↑以下是關於儲存格編輯觸發的程序
   If .Count > 1 Or .Item(1) = "" Then Exit Sub
   '↑如果觸發格數量大於 1 或觸發格空白!就結束程式執行
   If Not Intersect(Range("a2:c2"), .Cells) Is Nothing Then
   '↑如果觸發格是在[A2:A2]儲存格裡??
      .Cells(0, 1) = Val(.Cells(0, 1)) + Val(.Value)
      '↑令觸發格的上方那格的值 + (觸發格值以Val 函數轉化回傳的數值)
      .ClearContents
      '↑清除觸發格的內容
      '此清除的程序再次的觸發了,但是 .Item(1) = "" 所以結束程式執行
   End If
End With
End Sub

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

Andy2483

　暱稱: 厚臉皮的學生

碩士班 Rank: 5 Rank: 5

帖子: 1567
主題: 40
精華: 0
積分: 1591
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 100
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2026-2-2

13^#

發表於 2023-2-18 08:42 | 只看該作者

回復 11# coafort

建議使用准提部林前輩的方法更方便擴充使用該功能的儲存格
在以下程式碼藍字部位修改,即可擴充或變更
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
   If .Count > 1 Or .Item(1) = "" Then Exit Sub
   If Not Intersect([A2:C2,G2:I2], .Cells) Is Nothing Then
      .Cells(0, 1) = Val(.Cells(0, 1)) + Val(.Value)
      .ClearContents
   End If
End With
End Sub

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

coafort

中學生 Rank: 2

帖子: 173
主題: 36
精華: 0
積分: 257
點名: 0
作業系統: win7
軟體版本: excel 2003
閱讀權限: 20
註冊時間: 2018-1-5
最後登錄: 2025-9-2

14^#

發表於 2023-2-21 16:49 | 只看該作者

本帖最後由 coafort 於 2023-2-21 16:53 編輯

Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If .Count > 1 Or .Item(1) = " ...
准提部林發表於 2023-2-17 10:48

真是太感謝大大了
請問大大
我實際位置是
AQ212~AQ218及AQ212~AW218及BB221是輸入數值欄(觸發)
AR212~AR218及AX212~AX218及BC221是儲存格
請問要怎麼改呢？
謝謝大大

TOP

coafort

中學生 Rank: 2

帖子: 173
主題: 36
精華: 0
積分: 257
點名: 0
作業系統: win7
軟體版本: excel 2003
閱讀權限: 20
註冊時間: 2018-1-5
最後登錄: 2025-9-2

15^#

發表於 2023-2-21 16:52 | 只看該作者

回復 coafort

建議使用准提部林前輩的方法更方便擴充使用該功能的儲存格
在以下程式碼藍字部位 ...
Andy2483 發表於 2023-2-18 08:42

真是太感謝大大了
請問大大
我實際位置是
AQ212~AQ218及AQ212~AW218及BB221是輸入數值欄(觸發)
AR212~AR218及AX212~AX218及BC221是儲存格
請問要怎麼改呢？
謝謝大大

TOP

coafort

中學生 Rank: 2

帖子: 173
主題: 36
精華: 0
積分: 257
點名: 0
作業系統: win7
軟體版本: excel 2003
閱讀權限: 20
註冊時間: 2018-1-5
最後登錄: 2025-9-2

16^#

發表於 2023-2-21 19:34 | 只看該作者

本帖最後由 coafort 於 2023-2-21 19:37 編輯

打錯了
是
真是太感謝大大了
請問兩位大大
我實際位置是
AQ212~AQ218及AW212~AW218及BB221是輸入數值欄(觸發)
AR212~AR218及AX212~AX218及BC221是儲存格

我改成這樣
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
   If .Count > 1 Or .Item(1) = "" Then Exit Sub
   If Not Intersect([AQ212:AQ218,AW212:AW218,BB221], .Cells) Is Nothing Then
      .Cells(0, 1) = Val(.Cells(0, 1)) + Val(.Value)
      .ClearContents
   End If
End With
End Sub
但是出錯了
請問要怎麼改呢？
謝謝大大

TOP

Andy2483

　暱稱: 厚臉皮的學生

碩士班 Rank: 5 Rank: 5

帖子: 1567
主題: 40
精華: 0
積分: 1591
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 100
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2026-2-2

17^#

發表於 2023-2-22 07:35 | 只看該作者

本帖最後由 Andy2483 於 2023-2-22 08:04 編輯

回復 16# coafort

謝謝前輩一起學習
請前輩再測試看看,謝謝
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
'↑以下是關於儲存格編輯觸發的程序
   If .Count > 1 Or .Item(1) = "" Then Exit Sub
   '↑如果觸發格數量大於 1 或觸發格的下方格是空白!就結束程式執行
   If Not Intersect([AQ212:AQ218,AW212:AW218,BB221], .Cells) Is Nothing Then
   '↑如果觸發格是在[A2:A2]儲存格裡??
      .Cells(1, 2) = Val(.Cells(1, 2)) + Val(.Cells(1, 1))
   '↑令觸發格的右邊那1格的值 + (觸發格值以Val 函數轉化回傳的數值)

      '觸發格本身是.Cells(1,1), 右側1格是.Cells(1,2), 左側1格是.Cells(1,0),
      '上方1格是.Cells(0,1), 下方1格是.Cells(2,1)

      .ClearContents
      '↑清除觸發格的內容
      '此清除的程序再次的觸發了,但是 .Item(1) = "" 所以結束程式執行
   End If
End With
End Sub
Option Explicit

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

coafort