價格刪除張數自動刪除 - Excelㄧ般區 - 麻辣家族討論版版

麻辣家族討論版版 » Excelㄧ般區 » 價格刪除張數自動刪除

返回列表下一主題上一主題發帖

[發問] 價格刪除張數自動刪除

中學生 Rank: 2

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

31^# 跳轉到 »

發表於 2023-7-22 11:53 | 只看該作者

回復 coafort

謝謝前輩
後學藉此帖學習到 Workbook.SheetChange 事件
以下是學習方案,請前輩 ...
Andy2483 發表於 2023-7-21 08:41

請問大大，目前的設計是單一刪除跟著刪除一個
如果一次圈選好幾個無法跟著刪除
請問有辦法改嗎
謝謝大大

　暱稱: 厚臉皮的學生

碩士班 Rank: 5 Rank: 5

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

32^#

發表於 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

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

中學生 Rank: 2

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

33^#

發表於 2023-7-24 15:54 | 只看該作者

回復 32# Andy2483

報告大大，不能用呢
謝謝大大

　暱稱: 厚臉皮的學生

碩士班 Rank: 5 Rank: 5

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

34^#

發表於 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

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

中學生 Rank: 2

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

35^#

發表於 2023-7-25 08:17 | 只看該作者

回復 34# Andy2483

謝謝大大的幫忙
但還是無法使用
我改這樣
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/6/", "/" & Wi & "/") Then Set xP = [A3:A233,AA3:AA233,AO3:AO233,P3:P23,T3:T23,P27:P40,T27:T40]
'↑如果觸發工作表索引號是 2或3 ,就令xP變數是[]裡的儲存格
If InStr("/4/5/7/8/", "/" & Wi & "/") Then Set xP = [A3:A233,AD3:AD233,AS3:AS233,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

請問大大還有哪些需要改嗎？
非常謝謝大大

　暱稱: 厚臉皮的學生

碩士班 Rank: 5 Rank: 5

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

36^#

發表於 2023-7-25 09:10 | 只看該作者

回復 35# coafort

Andy自己模擬的測試檔測試OK
傳一份範例檔上來看看,請厲害的前輩們幫忙
後學工作忙,暫無法專心幫忙解決,容易漏東漏西的
謝謝論壇,謝謝各位前輩

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

中學生 Rank: 2

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

37^#

發表於 2023-7-25 11:51 | 只看該作者

回復 36# Andy2483

謝謝大大百忙中幫忙
大大是否方便提供寫好的範本呢
非常感恩

　暱稱: 厚臉皮的學生

碩士班 Rank: 5 Rank: 5

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

38^#

發表於 2023-7-25 12:55 | 只看該作者

回復 37# coafort

20230725.zip (14.35 KB)

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

中學生 Rank: 2

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

39^#

發表於 2023-8-5 06:12 | 只看該作者

回復 coafort
Andy2483 發表於 2023-7-25 12:55

感謝安迪大大
我試試看

靜思自在 : 有多少力量就做多少事，不要心存等待，等待才會落空。

返回列表下一主題上一主題