根据相邻单元格值锁定行中的单元格范围

Question

我正在使用 vba 代码使用两组工作表来审查和批准某些数据行： 第一个是“View_Form”，我们在特定表单视图中查看输入的数据。 第二个是“Tracker”，所有数据都从外部下载存储。

在“View_Form”表中，我们选择文件 ID 并显示与其相关的所有数据，如果一切正常，我们单击宏按钮“已批准”，文本“已批准”进入与所选文件 ID 相邻的 HR 列否则它将是空白的。

它可以工作，但我们仍然可以编辑我想要限制的“已批准”行。也就是说，如果 HR 单元格包含文本“已批准”，则 A:HR 中的特定行应该被锁定或应该限制用户编辑。

应该允许用户在使用密码取消保护工作表后进行编辑，例如密码为 123。

谁能帮我解决这个问题...

当前审批代码：

Sub Approval()
Dim found As Range 'define variables
Dim SelectedFileID As String

'Approval function
SelectedFileID = Sheets("View_Form").Range("SelFileID").Value 'get the currently selected File ID

Set found = Sheets("Tracker").Range("B:B").Find(What:=SelectedFileID) 'find the file ID in the Sheet Tracker
    If Not found Is Nothing Then 'if found
        Sheets("Tracker").Cells(found.Row, 226).Value = "Approved" 'change the value of the row it was found, but column 226 which is column HR
    Else
        MsgBox "ID not found in Sheet Tracker!", vbInformation 'if not found then show message
    End If
    ActiveWorkbook.Save '---------------Save workbook
    Application.DisplayAlerts = False
End Sub

Answer 1

这将锁定第 226 列包含“已批准”的所有行（您仍然可以使用密码解锁）：

Sub Picture1_Click()
Dim found As Range 'define variables
Dim SelectedFileID As String

SelectedFileID = Sheets("View_Form").Range("SelFileID").Value 'get the currently selected File ID
Application.DisplayAlerts = False    
Set found = Sheets("Tracker").Range("B:B").Find(What:=SelectedFileID) 'find the file ID in the Sheet Tracker
    If Not found Is Nothing Then 'if found
        Sheets("Tracker").Unprotect Password:="1234" 'change the password to whatever you wish, this unlocks the sheet
        Sheets("Tracker").Cells(found.Row, 226).Value = "Approved" 'change the value of the row it was found, but column 226 which is column HR
        Sheets("Tracker").Range("A1:HR500").Cells.Locked = False 'keeps range unlocked
        LastRow = Sheets("Tracker").Cells(Sheets("Tracker").Rows.Count, "A").End(xlUp).Row
        For i = 3 To LastRow
            If Sheets("Tracker").Cells(i, 226).Value = "Approved" Then
                Sheets("Tracker").Rows(i).Cells.Locked = True
            End If
        Next i
        Sheets("Tracker").Protect Password:="1234" 'protect the sheet after updating to Approved on Column HR
    Else
        MsgBox "ID not found in Sheet Tracker!", vbInformation 'if not found then show message
    End If
ActiveWorkbook.Save '---------------Save workbook
Application.DisplayAlerts = True
End Sub