隣接するセルの値に基づいて行内にあるセルの範囲をロックする

Question

私はvbaコードを使用して、2組のシートを使用して特定の行のデータを確認し、承認します： 1番目は「特定のフォームビューで入力したデータを確認します。 2番目は「トラッカー」で、すべてのデータが外部ダウンロードから保存されます。

「View_Form」シートでは、ファイルIDを選択し、それに関連するすべてのデータが表示され、すべてが良好であれば、「Approved」マクロをクリックし、選択したファイルに隣接する列HR IDそれ以外の場合は空白になります。

私はまだ動作していますが、依然として制限したい "Approved"の行を編集することができます。つまり、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