excel 根据其他单元格值锁定某些单元格

c6ubokkw  于 2022-12-20  发布在  其他
关注(0)|答案(1)|浏览(330)

我试图写一些东西,将锁定一个单元格的数据验证列表,如果另一个包含特定的值。
我尝试了下面的代码,希望当P中的单元格出现“ERROR”时,同一行上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
qyswt5oh

qyswt5oh1#

我还没有测试,如果你的整个代码的作品,因为我不知道什么样的数据,你使用...但这确实编译。
你必须做的是确保开始时所有单元格都解锁,然后脚本的锁定部分可以实际锁定它们:

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

相关问题