在文本input后使用与表单不同的密码locking单元格

我是新的excel VBA，我无法find我的答案任何地方。 在我的工作表“后续日志”中，我想要在A1:A70范围内没有文本的单元格，以允许用户进行编辑（然后在更改后自动locking），而带文本的单元格始终受密码保护。 我还希望范围使用与工作表不同的密码，并且在用户希望编辑具有范围内的文本的单元格时用户input密码。

我希望应用相同的代码范围B1:B70 ， K1:K70 ，但每个范围不同的密码，所有这些都不同于工作表。 总的来说，我打算有4张密码的单张。

我正在使用的当前代码在input文本之后locking单元格，但是它将更改工作表密码而不是单元格，并且只input一次密码。 这有道理吗？ 以下是我正在使用的代码：

 Private Sub Worksheet_Change(ByVal Target As Range) Dim blnUnlockedAllCells As Boolean Const RangeToLock As String = "A2:A70" '<< adjust to suit If Target.Cells.Count > 1 Then Exit Sub If Not blnUnlockedAllCells Then Me.Cells.Locked = False On Error Resume Next Me.Range(CStr(RangeToLock)).SpecialCells(2).Locked = True On Error GoTo 0 blnUnlockedAllCells = True Me.Protect Password:="pwd", userinterfaceonly:=True End If If Not Application.Intersect(Target, Me.Range(CStr(RangeToLock))) Is Nothing Then If Len(Target) Then Target.Locked = True End If 

Answer 1

你不需要locking它们。 我刚刚录制了这个macros来弄清楚如何做到多个范围：

 With ActiveSheet .Protection.AllowEditRanges.Add Title:="Range1", Range:=.Range("G8:J10"), Password:="qq" .Protection.AllowEditRanges.Add Title:="Range2", Range:=.Range("K11:L12"), Password:="aa" End With 

但请记住，如果该人知道如何打开代码窗口，他们将很容易看到您的密码。

Answer 2

代码“setupranges”可以设置范围和密码进行编辑。 这是所有的工作。 将以下两个子例程复制并粘贴到一个新模块中（插入一个模块）。 确保将密码更改为已设置的密码。

 Sub setupranges(wsname As String, rangeX As String) Dim rangea, rangeb, rangek As String Dim pwda, pwdb, pwdk As String Dim Ws As Worksheet Dim pwdws As String Set Ws = Worksheets(wsname) rangea = "A1:A70" rangeb = "B1:B70" rangek = "K1:K70" pwda = "aaa" pwdb = "bbb" pwdk = "kkk" pwdws = "pwd" On Error Resume Next Ws.Unprotect Password:=pwdws On Error GoTo 0 Select Case rangeX Case Is = "all" Call deleterangeifexists(Ws, "a") Ws.Protection.AllowEditRanges.Add Title:="arange",Range:=Ws.Range(rangea), Password:=pwda Call deleterangeifexists(Ws, "b") Ws.Protection.AllowEditRanges.Add Title:="brange", Range:=Ws.Range(rangeb), Password:=pwdb Call deleterangeifexists(Ws, "k") Ws.Protection.AllowEditRanges.Add Title:="krange", Range:=Ws.Range(rangek), Password:=pwdk Case Is = "a" Call deleterangeifexists(Ws, "arange") Ws.Protection.AllowEditRanges.Add Title:="arange", Range:=Ws.Range(rangea), Password:=pwda Case Is = "b" Call deleterangeifexists(Ws, "brange") Ws.Protection.AllowEditRanges.Add Title:="brange",Range:=Ws.Range(rangeb), Password:=pwdb Case Is = "k" Call deleterangeifexists(Ws, "krange") Ws.Protection.AllowEditRanges.Add Title:="krange", Range:=Ws.Range(rangek), Password:=pwdk End Select Ws.Protect Password:=pwdws, userinterfaceonly:=True End Sub 

如果在尝试添加范围时已经存在该范围，则会出现错误，因此如果该范围已经存在，则会删除该范围。

 Sub deleterangeifexists(Ws As Worksheet, Title As String) Dim rangetocheck As AllowEditRange For Each rangetocheck In Ws.Protection.AllowEditRanges If rangetocheck.Title = Title Then rangetocheck.Delete Exit Sub End If Next End Sub 

然后你必须从工作表中调用setuprange，例如调用setupranges（“sheet1”，“all”）将重置所有范围的所有密码。
调用setupranges（“sheet1”，“arange”）将仅重置列A中范围的密码。

我会build议worksheet_change或worksheet_selectionchange取决于您希望您的工作簿的行为。 用Worksheet_change记住，你的用户可能会解锁一个范围，然后不改变任何东西，所以你的例程不会运行，范围将保持解锁。 随着Worksheet_selectionchange代码的运行与每一个单元格的焦点，这可能是缓慢的变化。 其中一个给你的目标是你现在的细胞，一个给你你来自的细胞，这可能会让你更容易或更难。

无论哪种方式，你的工作表代码将有：如果条件为真（无论你想测量的条件）然后调用setupranges（“sheet1”，“全部”）结束如果