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

时间:2017-12-21 05:19:21

标签: excel-vba vba excel

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

In" 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

1 个答案:

答案 0 :(得分:0)

这将锁定列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