中财网孙杨4 100米比赛视频:及时条件锁定保护单元格不被修改
来源：百度文库 编辑：中财网 时间：2024/04/27 16:24:03
'1.首先将空白工作表的所有单元格的锁定属性设置为无
'2.如果A1值是 "保护" 那么输入一个保护一个,注意有值的单元格都会保护
'3.如果A1值是 "修改" 那么输入一个所有单元格都可以修改 不再保护，如需保护，请A1中输入"保护"
'4.功能：有条件的及时条件保护单元格
'5.作者：欢乐小爪
'6.修改水星钓鱼的代码 引用excelba的bengdeng的自定义函数,并感谢 水星钓鱼 bengdeng
'7.设置该工作表的VBA代码如下：
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell
ActiveSheet.Unprotect
'撤消工作表保护，以便设置单元格的锁定属性
On Error GoTo 100
If Target <> "" Then
For Each cell In GetCellTypeNotBlanks(Application.Union(ActiveSheet.Range("B1:IV1"), ActiveSheet.Range("A2:IV65536")))
If Range("A1") = "保护" Then
cell.Locked = True
cell.Borders.LineStyle = xlContinuous '
ElseIf Range("A1") = "修改" Then
Cells.Locked = False
Cells.Borders.LineStyle = xlNone
ActiveSheet.Unprotect
GoTo 100
End If
Next
End If
ActiveSheet.Protect
100:
End Sub
Function GetCellTypeNotBlanks(Target As Range) As Range
'*******************************************
'作者：bengdeng
'功能：获得指定单元格区域中的所有非空单元格
'发布：http://www.excelba.com
'*******************************************
Dim TRan As Range, RRan As Range
On Error Resume Next
Set TRan = Target.Parent.UsedRange.Item(ActiveSheet.UsedRange.Count).Offset(1, 0)
Set RRan = Union(TRan, Target)
Set GetCellTypeNotBlanks = RRan.ColumnDifferences(TRan)
End Function
源文件下载地址：http://u.xunzai.com/fileview_171841.html