当前一个单元格被填充时解锁下一个单元格
Unlock the next cell when previous cell is filled
情况
我有一个 excel 表单,我想确保用户进入一个序列,只有当初始单元格被填满时,下一个单元格才会被解锁。我的 excel sheet 也有一些复选框和合并在一起的单元格。
当前解决方案
我正在使用例如以下代码:-
If Range("V12").Value > 3 Or Range("V12").Value < 3 Then
Me.Unprotect
Range("E13:G17").Value = ""
Range("E13:G17").Interior.Color = RGB(226, 239, 218)
Range("E13:G17").Locked = True
Me.Protect
Else
Me.Unprotect
Range("E13:G17").Locked = False
Range("E13:G17").Interior.Color = RGB(255, 255, 255)
Me.Protect
但问题是,我有多个范围,我必须为剩余的范围编写一个重复的公式。
我的要求
这是最佳代码还是我仍然可以改进我的代码?我希望用户只在绿色区域中跳跃。
请通过这个link找到文件:-
Link to the excel file,please click here
你有很多重复的代码,如果你把 Protect/Unprotect 分解成一个单独的子代码,这些代码可能会大大减少。
例如:
Private Sub Worksheet_Change(ByVal Target As Range)
'...
'...
ProtectRange Me.Range("E13:G17"), (Me.Range("V12").Value > 3 Or _
Me.Range("V12").Value < 3)
ProtectRange Me.Range("L13:N17"), (Me.Range("V14").Value > 4 Or _
Me.Range("V14").Value < 4)
'...
'...
End Sub
'Protect/unprotect range `rng` based on boolean `DoLock` (defaults to True)
Sub ProtectRange(rng As Range, Optional DoLock As Boolean = True)
Me.Unprotect
If DoLock Then
Application.EnableEvents = False 'don't re-trigger event handler...
rng.ClearContents
Application.EnableEvents = True
End If
rng.Interior.Color = IIf(DoLock, RGB(226, 239, 218), RGB(255, 255, 255))
rng.Locked = DoLock
Me.Protect
End Sub
还会改进您的代码以在调用 lock/unlock 子程序之前检查(例如)V12 中的更改,而不是处理每个范围而不管更改事件在何处触发。
编辑 - 执行时应该更快的另一种方法 -
Option Explicit
Dim colLock As Collection 'any ranges to be locked
Dim colUnlock As Collection 'any ranges to be unlocked
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set colLock = New Collection 'reset collections
Set colUnlock = New Collection
'Test each section in turn and decide if to lock/unlock...
CheckRange Me.Range("V12"), Target, Me.Range("E13:G17"), _
(Me.Range("V12").Value > 3 Or Me.Range("V12").Value < 3)
CheckRange Me.Range("V14"), Target, Me.Range("L13:N17"), _
(Me.Range("V14").Value > 4 Or Me.Range("V14").Value < 4)
'check more ranges.....
'Done testing: anything to lock/unlock ?
If colLock.Count > 0 Or colUnlock.Count > 0 Then
Me.Unprotect
Application.EnableEvents = False
'loop over any collected ranges
For Each rng In colLock
rng.ClearContents
rng.Interior.Color = RGB(226, 239, 218)
rng.Locked = True
Next rng
For Each rng In colUnlock
rng.Interior.Color = RGB(255, 255, 255)
rng.Locked = False
Next rng
Application.EnableEvents = True
Me.Protect
End If
End Sub
'Check if `Target` includes `rngTrigger`, and if it does then collect `rngLock` in
' either `ColLock` or `colUnlock` depending on the test result in `doLock`
Sub CheckRange(rngTrigger As Range, Target As Range, rngLock As Range, doLock As Boolean)
If Not Application.Intersect(rngTrigger, Target) Is Nothing Then
If doLock Then
Debug.Print "Locking " & rngLock.Address()
colLock.Add rngLock
Else
Debug.Print "Unlocking " & rngLock.Address()
colUnlock.Add rngLock
End If
End If
End Sub
情况 我有一个 excel 表单,我想确保用户进入一个序列,只有当初始单元格被填满时,下一个单元格才会被解锁。我的 excel sheet 也有一些复选框和合并在一起的单元格。
当前解决方案 我正在使用例如以下代码:-
If Range("V12").Value > 3 Or Range("V12").Value < 3 Then
Me.Unprotect
Range("E13:G17").Value = ""
Range("E13:G17").Interior.Color = RGB(226, 239, 218)
Range("E13:G17").Locked = True
Me.Protect
Else
Me.Unprotect
Range("E13:G17").Locked = False
Range("E13:G17").Interior.Color = RGB(255, 255, 255)
Me.Protect
但问题是,我有多个范围,我必须为剩余的范围编写一个重复的公式。
我的要求 这是最佳代码还是我仍然可以改进我的代码?我希望用户只在绿色区域中跳跃。
请通过这个link找到文件:- Link to the excel file,please click here
你有很多重复的代码,如果你把 Protect/Unprotect 分解成一个单独的子代码,这些代码可能会大大减少。
例如:
Private Sub Worksheet_Change(ByVal Target As Range)
'...
'...
ProtectRange Me.Range("E13:G17"), (Me.Range("V12").Value > 3 Or _
Me.Range("V12").Value < 3)
ProtectRange Me.Range("L13:N17"), (Me.Range("V14").Value > 4 Or _
Me.Range("V14").Value < 4)
'...
'...
End Sub
'Protect/unprotect range `rng` based on boolean `DoLock` (defaults to True)
Sub ProtectRange(rng As Range, Optional DoLock As Boolean = True)
Me.Unprotect
If DoLock Then
Application.EnableEvents = False 'don't re-trigger event handler...
rng.ClearContents
Application.EnableEvents = True
End If
rng.Interior.Color = IIf(DoLock, RGB(226, 239, 218), RGB(255, 255, 255))
rng.Locked = DoLock
Me.Protect
End Sub
还会改进您的代码以在调用 lock/unlock 子程序之前检查(例如)V12 中的更改,而不是处理每个范围而不管更改事件在何处触发。
编辑 - 执行时应该更快的另一种方法 -
Option Explicit
Dim colLock As Collection 'any ranges to be locked
Dim colUnlock As Collection 'any ranges to be unlocked
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set colLock = New Collection 'reset collections
Set colUnlock = New Collection
'Test each section in turn and decide if to lock/unlock...
CheckRange Me.Range("V12"), Target, Me.Range("E13:G17"), _
(Me.Range("V12").Value > 3 Or Me.Range("V12").Value < 3)
CheckRange Me.Range("V14"), Target, Me.Range("L13:N17"), _
(Me.Range("V14").Value > 4 Or Me.Range("V14").Value < 4)
'check more ranges.....
'Done testing: anything to lock/unlock ?
If colLock.Count > 0 Or colUnlock.Count > 0 Then
Me.Unprotect
Application.EnableEvents = False
'loop over any collected ranges
For Each rng In colLock
rng.ClearContents
rng.Interior.Color = RGB(226, 239, 218)
rng.Locked = True
Next rng
For Each rng In colUnlock
rng.Interior.Color = RGB(255, 255, 255)
rng.Locked = False
Next rng
Application.EnableEvents = True
Me.Protect
End If
End Sub
'Check if `Target` includes `rngTrigger`, and if it does then collect `rngLock` in
' either `ColLock` or `colUnlock` depending on the test result in `doLock`
Sub CheckRange(rngTrigger As Range, Target As Range, rngLock As Range, doLock As Boolean)
If Not Application.Intersect(rngTrigger, Target) Is Nothing Then
If doLock Then
Debug.Print "Locking " & rngLock.Address()
colLock.Add rngLock
Else
Debug.Print "Unlocking " & rngLock.Address()
colUnlock.Add rngLock
End If
End If
End Sub