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

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