麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 價格刪除張數自動刪除 [打印本頁]

作者: coafort 時間: 2021-11-22 09:08 標題: 價格刪除張數自動刪除

請教各位大大
a1是價格
a2是張數
兩個儲存格的數字都是要用手動輸入
請問有辦法設計成
a1如果刪除了
a2會自動刪除嗎？
謝謝

作者: samwang 時間: 2021-11-22 09:51

回復 1# coafort

請測試看看，謝謝
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then
If Target.Value = "" Then Range("a2").ClearContents
End If
End Sub

作者: coafort 時間: 2021-11-22 10:01

回復 coafort

請測試看看，謝謝
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.A ...
samwang 發表於 2021-11-22 09:51

謝謝大大
請問大大
因為我有好幾個工作表
然後每一個都好幾列
那這樣要怎寫呢
謝謝

作者: samwang 時間: 2021-11-22 10:28

謝謝大大
請問大大
因為我有好幾個工作表
然後每一個都好幾列
那這樣要怎寫呢
謝謝
coafort 發表於 2021-11-22 10:01

因為我有好幾個工作表 >> 可以將程式碼放在ThisWorkbook
然後每一個都好幾列 >> 不太瞭解意思，可以附檔加以說明，謝謝

作者: coafort 時間: 2021-11-22 10:51

因為我有好幾個工作表 >> 可以將程式碼放在ThisWorkbook
然後每一個都好幾列 >> 不太瞭解意思，可以附檔 ...
samwang 發表於 2021-11-22 10:28

就是這個資料不只有一行
而是有好幾百行以上
比方
謝謝大大
[attach]34420[/attach]

作者: samwang 時間: 2021-11-22 11:26

回復 5# coafort

請測試看看，謝謝
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
With Target
If .Column = 1 Then
If .Count > 1 Then Exit Sub
If .Value = "" Then .Offset(, 1).ClearContents
End If
End With
End Sub

作者: coafort 時間: 2021-11-22 12:09

回復 coafort

請測試看看，謝謝
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Targe ...
samwang 發表於 2021-11-22 11:26

請問大大~我有10個工作表
只有1~6需要這個功能
請問要怎改呢？
謝謝大大

作者: samwang 時間: 2021-11-22 13:00

請問大大~我有10個工作表
只有1~6需要這個功能
請問要怎改呢？
謝謝大大
coafort 發表於 2021-11-22 12:09

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
With Target
If .Worksheet.Index > 6 Then Exit Sub
If .Column = 1 Then
If .Count > 1 Then Exit Sub
If .Value = "" Then .Offset(, 1).ClearContents
End If
End With
End Sub

作者: coafort 時間: 2021-11-22 13:22

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
With Target
If ...
samwang 發表於 2021-11-22 13:00

謝謝大大，可以了:D
請問大大，所以只有1~6名稱的工作表才會有效果其他名稱工作表不會發生效果嗎？
謝謝大大

作者: samwang 時間: 2021-11-22 13:26

回復 9# coafort

請問大大，所以只有1~6名稱的工作表才會有效果其他名稱工作表不會發生效果嗎？
>> 是前面1~6的工作表才會執行，謝謝

作者: coafort 時間: 2021-11-22 13:34

回復 10# samwang

謝謝大大
那請問大大，因為我1~6名稱是從第二個工作表開始
所以實際上位置是2~7
If .Worksheet.Index > 6 Then Exit Sub
那這行要怎麼改呢？
又再請教
如果除了第一個位置，比方27和41這兩個欄位也要這個功能要怎麼寫呢？
非常感謝大大

作者: samwang 時間: 2021-11-22 14:32

回復 11# coafort

那請問大大，因為我1~6名稱是從第二個工作表開始
所以實際上位置是2~7
If .Worksheet.Index > 6 Then Exit Sub
那這行要怎麼改呢？
>> If .Worksheet.Index =1 Then Exit Sub
If .Worksheet.Index >7 Then Exit Sub

作者: coafort 時間: 2021-11-22 14:36

回復 12# samwang

報告大大，我改成這樣，其他三個欄位都可以用了
有大大真好
回覆快速又能解決問題
再次感恩大大的鼎力協助:loveliness:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
With Target
If .Worksheet.Index = 1 Then Exit Sub
If .Worksheet.Index > 7 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
End With
End Sub

作者: coafort 時間: 2022-1-26 15:02

回復 coafort

那請問大大，因為我1~6名稱是從第二個工作表開始
所以實際上位置是2~7
If .Workshee ...
samwang 發表於 2021-11-22 14:32

請問大大
如果P3到P24刪除，Q3到Q24也會刪除的話
要怎麼寫呢？
謝謝大大

作者: samwang 時間: 2022-1-26 16:51

回復 14# coafort

不好意思，看不太懂意思，請您提供附檔且說明一下條件規則，謝謝

作者: coafort 時間: 2022-1-27 08:36

回復 coafort

不好意思，看不太懂意思，請您提供附檔且說明一下條件規則，謝謝
samwang 發表於 2022-1-26 16:51

[attach]34628[/attach]

報告大大，如圖，P這一欄從p3到P25
p3數值刪除Q3就會自動刪除
依此類推
謝謝大大

作者: samwang 時間: 2022-1-27 09:42

回復 16# coafort

請測試看看，謝謝
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
With Target
   If .Worksheet.Index = 1 Then Exit Sub
   If .Worksheet.Index > 7 Then Exit Sub
   If .Column = 16 Then
      If .Count > 1 Then Exit Sub
      If .Value = "" Then .Offset(, 1).ClearContents
   End If
End With
End Sub

作者: coafort 時間: 2022-1-27 09:57

回復 coafort

請測試看看，謝謝
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Targ ...
samwang 發表於 2022-1-27 09:42

報告大大
我只需要p3到P25這幾列
P26以下的希望不影響
不知道這要怎麼改呢
謝謝大大

作者: samwang 時間: 2022-1-27 10:20

回復 18# coafort

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
With Target
   If .Worksheet.Index = 1 Then Exit Sub
   If .Worksheet.Index > 7 Then Exit Sub
   If .Column = 16 Then
      If .Row < 3 Then Exit Sub
      If .Row > 25 Then Exit Sub
      If .Count > 1 Then Exit Sub
      If .Value = "" Then .Offset(, 1).ClearContents
   End If
End With
End Sub

作者: coafort 時間: 2022-1-27 13:36

回復 coafort

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

非常感恩S大大
，有您真好:D

作者: coafort 時間: 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

作者: samwang 時間: 2022-1-29 12:21

請問大大
如果同一欄
3~23
27~40
需要這個功能
請問該怎麼改呢？
我改成以下，只有3~23有這功能， ...
coafort 發表於 2022-1-29 08:56

   If .Column = 16 Then
      If .Row < 3 Then Exit Sub
      If .Row > 40 Then Exit Sub
      If .Row = 26 Then Exit Sub
      If .Count > 1 Then Exit Sub
      If .Value = "" Then .Offset(, 1).ClearContents
   End If

作者: coafort 時間: 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也是要輸入呢？
謝謝大大

作者: samwang 時間: 2022-1-29 13:56

大大您好
3~40當中
24~26這三列是不需要的
大大的方式好像只有26
還是說另外24 25也是要輸入呢？
...
coafort 發表於 2022-1-29 12:44

If .Row >= 24 And .Row <= 26 Then Exit Sub

作者: coafort 時間: 2022-1-29 14:24

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

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

作者: coafort 時間: 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
謝謝大大

作者: Andy2483 時間: 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

作者: coafort 時間: 2023-7-21 08:54

回復 coafort

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

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

作者: Andy2483 時間: 2023-7-21 09:10

回復 28# coafort

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

作者: coafort 時間: 2023-7-21 15:46

回復 coafort

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

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

作者: coafort 時間: 2023-7-22 11:53

回復 coafort

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

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

作者: Andy2483 時間: 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

作者: coafort 時間: 2023-7-24 15:54

回復 32# Andy2483

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

作者: Andy2483 時間: 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

作者: coafort 時間: 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

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

作者: Andy2483 時間: 2023-7-25 09:10

回復 35# coafort

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

作者: coafort 時間: 2023-7-25 11:51

回復 36# Andy2483

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

作者: Andy2483 時間: 2023-7-25 12:55

回復 37# coafort

[attach]36745[/attach]

作者: coafort 時間: 2023-8-5 06:12

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

感謝安迪大大
我試試看

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)