想实现某条件下自动清空内容，禁止输入并在输入时给出警告的功能

小白01

各位大神，想实现单元格在某条件下自动清空、禁止输入并且再输入时给出警告的功能。比如：F6单元格内容为“广播”时，后面的H6:M6单元格自动清空，如果有内容输入，再次清空并且给出警告“选择广播时禁止输入此单元格”，需要在第6行到第500行的每一行在选择“广播”时都要实现上面说的功能。谢谢！

小象啊啊

请参考附件。

小白01

小象啊啊 发表于 2022-10-15 18:10
请参考附件。

可以实现功能，谢谢，另外能否帮我在代码上做个注释，我是初学者，一方面是想学一学，另一方面，如果有别的微调，我也可以自己修改代码，大概看懂了第一段和第二段的代码，第三段的没看懂。麻烦了

feilanga

1. Private Sub Worksheet_Change(ByVal Target As Range) '单元格改变触发的change事件
   
2. Application.EnableEvents = False '关闭事件,以避免重复触发事件
   
3. '实现不能输入的功能
   
4. If Target.Row >= 6 And Target.Row <= 500 Then '行大于等于6 小于等于500才触发事件
   
5.       If Target.Column >= 8 And Target.Column <= Range("m1").Column Then '列大于等于8 小于等于m列才触发事件
   
6.             If Cells(Target.Row, 6) = "广播" Then '如果单元格输入值所在行的第6列=广播 那么
   
7.                   MsgBox "选择广播时禁止输入此单元格", vbExclamation '弹窗提示
   
8.                   Target.Value = "" '输入值清空
   
9.             End If
   
10.       End If
    
11. End If
    
12. '实现清空的功能
    
13. If Target.Row >= 6 And Target.Row <= 500 Then '限定事件触发的行列范围
    
14.       If Target.Column = 6 Then
    
15.             If Target.Value = "广播" Then '如果输入值=广播 那么
    
16.                   Target.Offset(0, 2).Resize(1, 6).ClearContents '输入值向右偏移2列为顶点扩展1行号6列的区域清空
    
17.             End If
    
18.       End If
    
19. End If
    
20. Application.EnableEvents = True '事件开启
    
21. End Sub
    
22. 
    
23. 
    
24. Sub 清空()
    
25. arr1 = Sheet3.Range("b6:n" & Sheet3.Range("b" & Rows.Count).End(xlUp).Row)
    
26. '单元格B6:n最大行的区域装入数组
    
27. For i = 1 To UBound(arr1, 1) '从第1行循环到最大行
    
28.       If arr1(i, 5) = "广播" Then '如果第i行第5列=广播 那么
    
29.             For j = 7 To UBound(arr1, 2) - 1 '从第7列到最大列-1列的区域清空
    
30.                   arr1(i, j) = ""
    
31.             Next j
    
32.       End If
    
33. Next i
    
34. With Sheet3.Range("b6") 'with省略语句
    
35. .Resize(UBound(arr1, 1), UBound(arr1, 2)) = arr1
    
36. '数组重新写入到以单元格b6为顶点扩展数组的行数,列数的单元格区域
    
37. End With
    
38. End Sub

复制代码

小白01

feilanga 发表于 2022-10-15 20:19

非常感谢

02761752696

小白01 发表于 2022-10-17 10:24
非常感谢

练习一下

小白01

02761752696 发表于 2022-10-17 11:03
练习一下

多谢

小白01

02761752696 发表于 2022-10-17 11:03
练习一下

您好，昨天试了几次您帮我写的功能后发现，在复制或删除两行以上的信息时，写的代码就失灵了，因为在填表过程种避免不了大量的数据删除或复制粘贴，所以能否帮我改一下代码，改成在删除或复制粘贴后功能依然能实现。多谢

02761752696

小白01 发表于 2022-10-18 14:57
您好，昨天试了几次您帮我写的功能后发现，在复制或删除两行以上的信息时，写的代码就失灵了，因为在填表 ...

不了解操作情况，疏忽了，可以这样处理

02761752696

小白01 发表于 2022-10-18 14:57
您好，昨天试了几次您帮我写的功能后发现，在复制或删除两行以上的信息时，写的代码就失灵了，因为在填表 ...

两个红框的内容任意用一个都能解决你的问题