简体   繁体   English

根据另一个单元格的值锁定某些单元格

[英]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.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM