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

帖子: 156
主題: 31
精華: 0
積分: 235
點名: 0
作業系統: win7
軟體版本: excel 2003
閱讀權限: 20
註冊時間: 2018-1-5
最後登錄: 2024-3-8

12^#

發表於 2022-1-29 08:56 | 顯示全部帖子

回復 coafort

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
With ...
samwang 發表於 2022-1-27 10:20

請問大大
如果同一欄
3~23
27~40
需要這個功能
請問該怎麼改呢？
我改成以下，只有3~23有這功能，27~40沒有
謝謝大大
  If .Column = 16 Then
      If .Row < 3 Then Exit Sub
      If .Row > 23 Then Exit Sub
      If .Count > 1 Then Exit Sub
      If .Value = "" Then .Offset(, 1).ClearContents
      End If
If .Column = 16 Then
      If .Row < 27 Then Exit Sub
      If .Row > 40 Then Exit Sub
      If .Count > 1 Then Exit Sub
      If .Value = "" Then .Offset(, 1).ClearContents
      End If

帖子: 156
主題: 31
精華: 0
積分: 235
點名: 0
作業系統: win7
軟體版本: excel 2003
閱讀權限: 20
註冊時間: 2018-1-5
最後登錄: 2024-3-8

13^#

發表於 2022-1-29 12:44 | 顯示全部帖子

If .Column = 16 Then
If .Row < 3 Then Exit Sub
If .Row > 40 Then Exit ...
samwang 發表於 2022-1-29 12:21

大大您好
3~40當中
24~26這三列是不需要的
大大的方式好像只有26
還是說另外24 25也是要輸入呢？
謝謝大大

帖子: 156
主題: 31
精華: 0
積分: 235
點名: 0
作業系統: win7
軟體版本: excel 2003
閱讀權限: 20
註冊時間: 2018-1-5
最後登錄: 2024-3-8

14^#

發表於 2022-1-29 14:24 | 顯示全部帖子

If .Row >= 24 And .Row
samwang 發表於 2022-1-29 13:56

謝謝大大
終於可以了
有大大真好
祝福大大虎年行大運
新年大快樂:D

帖子: 156
主題: 31
精華: 0
積分: 235
點名: 0
作業系統: win7
軟體版本: excel 2003
閱讀權限: 20
註冊時間: 2018-1-5
最後登錄: 2024-3-8

15^#

發表於 2023-7-20 16:19 | 顯示全部帖子

請問大大，下列要如何整合呢？
我用分割線分隔
也就是第二第三的工作表是這個
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
With Target
If .Worksheet.Index = 1 Then Exit Sub
If .Worksheet.Index > 3 Then Exit Sub
If .Column = 41 Then
      If .Count > 1 Then Exit Sub
      If .Value = "" Then .Offset(, 1).ClearContents
      End If
If .Column = 27 Then
      If .Count > 1 Then Exit Sub
      If .Value = "" Then .Offset(, 1).ClearContents
      End If
If .Column = 1 Then
      If .Count > 1 Then Exit Sub
      If .Value = "" Then .Offset(, 1).ClearContents
      End If
If .Column = 16 Then
      If .Row < 3 Then Exit Sub
      If .Row > 40 Then Exit Sub
      If .Row >= 24 And .Row <= 26 Then Exit Sub
      If .Count > 1 Then Exit Sub
      If .Value = "" Then .Offset(, 1).ClearContents
   End If
If .Column = 20 Then
      If .Row < 3 Then Exit Sub
      If .Row > 40 Then Exit Sub
      If .Row >= 24 And .Row <= 26 Then Exit Sub
      If .Count > 1 Then Exit Sub
      If .Value = "" Then .Offset(, 1).ClearContents
   End If

第四第五的第七第八工作表是這個
================================================================
If .Worksheet.Index = 6 Then Exit Sub
If .Worksheet.Index > 4 Then Exit Sub
If .Worksheet.Index > 8 Then Exit Sub
If .Column = 45 Then
      If .Count > 1 Then Exit Sub
      If .Value = "" Then .Offset(, 1).ClearContents
      End If
If .Column = 30 Then
      If .Count > 1 Then Exit Sub
      If .Value = "" Then .Offset(, 1).ClearContents
      End If
If .Column = 1 Then
      If .Count > 1 Then Exit Sub
      If .Value = "" Then .Offset(, 1).ClearContents
      End If
If .Column = 17 Then
      If .Row < 3 Then Exit Sub
      If .Row > 40 Then Exit Sub
      If .Row >= 24 And .Row <= 26 Then Exit Sub
      If .Count > 1 Then Exit Sub
      If .Value = "" Then .Offset(, 1).ClearContents
   End If
If .Column = 22 Then
      If .Row < 3 Then Exit Sub
      If .Row > 40 Then Exit Sub
      If .Row >= 24 And .Row <= 26 Then Exit Sub
      If .Count > 1 Then Exit Sub
      If .Value = "" Then .Offset(, 1).ClearContents
   End If
  End With
End Sub
謝謝大大

帖子: 156
主題: 31
精華: 0
積分: 235
點名: 0
作業系統: win7
軟體版本: excel 2003
閱讀權限: 20
註冊時間: 2018-1-5
最後登錄: 2024-3-8

16^#

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

回復 coafort

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

真是非常感謝大大幫忙
可以了
讚讚

帖子: 156
主題: 31
精華: 0
積分: 235
點名: 0
作業系統: win7
軟體版本: excel 2003
閱讀權限: 20
註冊時間: 2018-1-5
最後登錄: 2024-3-8

17^#

發表於 2023-7-21 15:46 | 顯示全部帖子

回復 coafort

恭喜
後學認為用工作表索引號辨識風險高(萬一不小心變動順序)
建議還是以工作表 ...
Andy2483 發表於 2023-7-21 09:10

真的很好用
真的很感謝會VB的安迪大大

帖子: 156
主題: 31
精華: 0
積分: 235
點名: 0
作業系統: win7
軟體版本: excel 2003
閱讀權限: 20
註冊時間: 2018-1-5
最後登錄: 2024-3-8

18^#

發表於 2023-7-22 11:53 | 顯示全部帖子

回復 coafort

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

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

帖子: 156
主題: 31
精華: 0
積分: 235
點名: 0
作業系統: win7
軟體版本: excel 2003
閱讀權限: 20
註冊時間: 2018-1-5
最後登錄: 2024-3-8

19^#

發表於 2023-7-24 15:54 | 顯示全部帖子

回復 32# Andy2483

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

帖子: 156
主題: 31
精華: 0
積分: 235
點名: 0
作業系統: win7
軟體版本: excel 2003
閱讀權限: 20
註冊時間: 2018-1-5
最後登錄: 2024-3-8

20^#

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

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