價格刪除張數自動刪除 - Excelㄧ般區

　暱稱: 厚臉皮的學生

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

1^# 跳轉到 »

發表於 2023-7-21 08:41 | 顯示全部帖子

本帖最後由 Andy2483 於 2023-7-21 08:46 編輯

回復 26# coafort

謝謝前輩
後學藉此帖學習到 Workbook.SheetChange 事件
以下是學習方案,請前輩參考

Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Wi%, Wc%, Wr&
'↑宣告變數
With Target
If .Count > 1 Then Exit Sub
'↑任何表只要變更格大於1格就結束程式執行
Wi = .Worksheet.Index: Wc = .Column: Wr = .Row
'↑令Wi是觸發工作表索引號,令Wc是觸發欄號,令Wr是觸發列號

'////第二第三的工作表////
If InStr("/2/3/", "/" & Wi & "/") Then
'↑如果觸發表索引號是 2或3 ??
   If InStr("/1/27/41/", "/" & Wc & "/") Then
   '↑如果觸發欄是 1,27或41
      If .Value = "" Then .Offset(, 1).ClearContents
   End If
   If InStr("/16/20/", "/" & Wc & "/") Then
      If Wr < 3 Or Wr > 40 Or (Wr >= 24 And Wr <= 26) Then Exit Sub
      If .Value = "" Then .Offset(, 1).ClearContents
      '↑如果觸發列是 3~23 或 27~40
   End If
End If

'////第四第五的第七第八工作表////
If InStr("/4/5/7/8/", "/" & Wi & "/") Then
'↑如果觸發表索引號是 4,5,7或8 ??
   If InStr("/1/30/45/", "/" & Wc & "/") Then
   '↑如果觸發欄是 1,30或45
      If .Value = "" Then .Offset(, 1).ClearContents
   End If
   If InStr("/17/22/", "/" & Wc & "/") Then
      If Wr < 3 Or Wr > 40 Or (Wr >= 24 And Wr <= 26) Then Exit Sub
      If .Value = "" Then .Offset(, 1).ClearContents
   End If
End If
End With
End Sub

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

TOP

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

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

2^#

發表於 2023-7-21 09:10 | 顯示全部帖子

回復 28# coafort

恭喜
後學認為用工作表索引號辨識風險高(萬一不小心變動順序)
建議還是以工作表名辨識比較好

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

TOP

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

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

3^#

發表於 2023-7-24 13:22 | 顯示全部帖子

回復 31# coafort

謝謝前輩再回復,一起學習
後學學習方案如下,請前輩參考

Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Wi%, xA As Range, xR As Range, xP As Range, xI As Range
With Target
On Error GoTo 99
Set xA = Intersect(.Cells, Range([A1], ActiveSheet.UsedRange)).SpecialCells(4)
On Error GoTo 0
Wi = .Worksheet.Index
If InStr("/2/3/", "/" & Wi & "/") Then Set xP = [A:A,AA:AA,AO:AO,P3:P23,T3:T23,P27:P40,T27:T40]
If InStr("/4/5/7/8/", "/" & Wi & "/") Then Set xP = [A:A,AD:AD,AS:AS,Q3:Q23,V3:V23,Q27:Q40,V27:V40]
Set xI = Intersect(xP, xA)
If xI Is Nothing Then Exit Sub
If Intersect(xI, .Cells) Is Nothing Then Exit Sub
For Each xR In xI: xR.Offset(, 1).ClearContents: Next
99: End With
End Sub

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

TOP

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

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

4^#

發表於 2023-7-25 07:21 | 顯示全部帖子

回復 33# coafort

謝謝前輩再回復
後學藉此帖複習方案,方案心得註解如下,請前輩參考

Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Wi%, xA As Range, xR As Range, xP As Range, xI As Range
'↑宣告變數:Wi是短整數,(xA,xR,xP,xI)都是儲存格變數
With Target
On Error GoTo 99
'↑程序遇到錯誤就跳到標示 99的位置繼續執行
Set xA = Intersect(.Cells, Range([A1], ActiveSheet.UsedRange)).SpecialCells(4)
'↑令xA變數是交集格(觸發格與有使用格)裡的空白格
Wi = .Worksheet.Index
'↑令Wi變數是觸發工作表索引號
If InStr("/2/3/", "/" & Wi & "/") Then Set xP = [A:A,AA:AA,AO:AO,P3:P23,T3:T23,P27:P40,T27:T40]
'↑如果觸發工作表索引號是 2或3 ,就令xP變數是[]裡的儲存格
If InStr("/4/5/7/8/", "/" & Wi & "/") Then Set xP = [A:A,AD:AD,AS:AS,Q3:Q23,V3:V23,Q27:Q40,V27:V40]
'↑如果觸發工作表索引號是 4.5.7或8 ,就令xP變數是[]裡的儲存格
Set xI = Intersect(xP, xA)
'↑令xI變數是交集格(xP變數與xA變數)
If xI Is Nothing Then Exit Sub
'↑如果xI變數是無物件? True就結束程序執行
If Intersect(xI, .Cells) Is Nothing Then Exit Sub
'↑如果交集格(xI變數與觸發格)是無物件? True就結束程序執行
For Each xR In xI: xR.Offset(, 1).ClearContents: Next
'↑設逐項迴圈!令xR變數是 xI變數裡的一格,令右側隔壁格清除內容
99: End With
End Sub

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

TOP

Andy2483