[英]Lock Certain Cells Based On Another Cells Value
Im trying to write something that will lock a cells data validation list if another one contains a certain value.我试图写一些东西,如果另一个单元格数据验证列表包含某个值,它将锁定单元格数据验证列表。
I tried the following code expecting that when a cell in P had "ERROR" the cell in Q on the same row would be locked however I was still able to change the item from the data validation list.我尝试了以下代码,期望当 P 中的单元格出现“错误”时,同一行 Q 中的单元格将被锁定,但是我仍然能够从数据验证列表中更改项目。
Sub ABCD()
Application.ScreenUpdating = False
Dim data_sh As Worksheet
Set data_sh = ThisWorkbook.Sheets("1234")
Dim setting_sh As Worksheet
Set setting_sh = ThisWorkbook.Sheets("5678")
Dim nwb As Workbook
Dim nsh As Worksheet
'get unique NAME
setting_sh.Range("A:A").Clear
data_sh.AutoFilterMode = False
data_sh.Range("C:C").Copy setting_sh.Range("A1")
setting_sh.Range("A:A").RemoveDuplicates 1, xlYes
Dim i As Integer
For i = 2 To Application.CountA(setting_sh.Range("A:A"))
data_sh.UsedRange.AutoFilter 3, setting_sh.Range("A" & i).Value
Set nwb = Workbooks.Add
Set nsh = nwb.Sheets(1)
data_sh.UsedRange.SpecialCells(xlCellTypeVisible).Copy nsh.Range("A1")
nsh.Columns("A:U").AutoFit
If Range("P" & i) = "ERROR" Then
Range("Q" & i).Locked = True
End If
nwb.SaveAs ****
nwb.Close False
data_sh.AutoFilterMode = False
Next i
setting_sh.Range("A:A").Clear
End Sub
I haven't tested if your whole code works as I'm not sure what kind of data you're using... but this does compile.我没有测试你的整个代码是否有效,因为我不确定你使用的是哪种数据......但这确实可以编译。
What you MUST do is make sure to start with all cell unlocked, then the locking section of the script can actually lock them:您必须做的是确保所有单元格都已解锁,然后脚本的锁定部分实际上可以锁定它们:
Sub ABCD()
Application.ScreenUpdating = False
Dim data_sh As Worksheet
Set data_sh = ThisWorkbook.Sheets("1234")
Dim setting_sh As Worksheet
Set setting_sh = ThisWorkbook.Sheets("5678")
Dim nwb As Workbook
Dim nsh As Worksheet
'get unique NAME
setting_sh.Range("A:A").Clear
data_sh.AutoFilterMode = False
data_sh.Range("C:C").Copy setting_sh.Range("A1")
setting_sh.Range("A:A").RemoveDuplicates 1, xlYes
Dim i As Integer
For i = 2 To Application.CountA(setting_sh.Range("A:A"))
data_sh.UsedRange.AutoFilter 3, setting_sh.Range("A" & i).Value
Set nwb = Workbooks.Add
Set nsh = nwb.Sheets(1)
data_sh.UsedRange.SpecialCells(xlCellTypeVisible).Copy nsh.Range("A1")
nsh.Columns("A:U").AutoFit
If Range("P" & i) = "ERROR" Then
' I'm assuming you're working with data_sh here... but idk
' I would consider making it absolute.
data_sh.Unprotect "This is a password"
data_sh.Range("Q" & i).Locked = True
data_sh.Protect "This is a password"
End If
nwb.SaveAs "C:\Users\cameron\Documents"
nwb.Close False
data_sh.AutoFilterMode = False
Next i
setting_sh.Range("A:A").Clear
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.