Как вы можете заблокировать строки ячеек в Excel на основе значения ячейки? - PullRequest
0 голосов
/ 16 марта 2020

Итак, я знаю, что можно отформатировать ячейки для блокировки, а затем защитить лист, чтобы предотвратить перезапись этих данных. Но я ищу возможность динамически блокировать ячейки на листе. После некоторого поиска в Google я попытался адаптировать приведенный ниже блок кода под свои нужды. Намерение состоит в том, что если столбец A имеет значение, остальная часть строки будет заблокирована, поэтому никто не сможет перезаписать остальную часть строки.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(ActiveSheet.Cells(18, 1), Target) Is Not Nothing Then
        If ActiveSheet.Cells(18, 1).Text = "X" Then
            ActiveSheet.Range(Cells(18, 2), Cells(18, 20)).Locked = True
        Else
            ActiveSheet.Range(Cells(18, 2), Cells(18, 20)).Locked = False
        End If
    End If
End Sub

Любая помощь будет высоко ценится, а также советы по кратко применяя это к каждой строке в листе.

ОБНОВЛЕНИЕ:

В ответе BigBen я изменил следующее:

Private Sub Workbook_Open()
    Sheets(“Sheet8”).Protect Password:="Secret", UserInterFaceOnly:=True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    Set rng = Intersect(Me.Columns(1), Target)

    If rng Is Nothing Then Exit Sub

    Dim cell As Range
    For Each cell In rng
        cell.EntireRow.Locked = (cell.Value = "X")
    Next
End Sub

Но это все еще не кажется, работает ...

1 Ответ

1 голос
/ 16 марта 2020

Вам нужно изменить Intersect, чтобы проверить, пересекает ли Target столбец A, а не конкретную ячейку:

Обратите внимание также на синтаксис Not: If Not Intersect... Is Nothing вместо If Intersect... Is Not Nothing .

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Me.Columns(1), Target) Is Nothing Then
        Dim rng as Range
        For Each rng in Intersect(Me.Columns(1), Target)
            If rng.Value = "X" Then
                rng.EntireRow.Locked = True
            Else
                rng.EntireRow.Locked = False
            End If
        Next
    End If
End Sub

Или, возможно, более кратко:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    Set rng = Intersect(Me.Columns(1), Target)

    If rng Is Nothing Then Exit Sub

    Dim cell As Range
    For Each cell In rng
        cell.EntireRow.Locked = (cell.Value = "X")
    Next
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...