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

Question

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

在“ View_Form”工作表中，我们选择“文件ID”，并显示所有与之相关的数据，如果一切看起来都很好，我们单击“批准”宏按钮，而文本““已批准””将进入HR列，与所选文件ID相邻，否则它将空白。

它可以正常工作，但我们仍然可以编辑我要限制的“已批准”行。 就是说，如果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