Запретить пользователю удалять определенные строки на основе содержимого ячейки в этой строке

Question

У меня есть файл шаблона, который я хочу защитить, чтобы пользователи не могли изменять формулы.Поскольку лист защищен, я написал макрос, позволяющий пользователю вставлять строки.Я также хочу, чтобы макрос позволял пользователю удалять строки, но я хочу запретить пользователю удалять определенные критические строки (например, проверять итоги и заголовки и т. Д.).

Для этого я использовал столбец L в своем шаблоне для определения строк, которые нельзя удалить.Для этих строк у меня есть слово "keep" в этой строке столбца L. Ниже я написал базовый макрос удаления, но мне нужно изменить его, чтобы он смотрел в столбце L выбранного диапазона rRange и Exit Sub, если слово"keep" там.

* Обратите внимание, что rRange может содержать несколько смежных строк, поэтому макрос должен будет выйти, если любая из этих строк не пройдёт тест.

Sub DeteteRows()

Dim rRange As Range
On Error Resume Next
    Application.DisplayAlerts = False
     Set rRange = Application.InputBox(Prompt:= _
            "Please use mouse to select a row to Delete.", _
                Title:="SPECIFY ROW TO DELETE", Type:=8)
On Error GoTo 0
    Application.DisplayAlerts = True
    If rRange Is Nothing Then

    Exit Sub

    Else

rRange.EntireRow.Delete
Range("a1").Select

MsgBox ("Row(s) Deteted")
    End If

End Sub

Answer 1

Возможно, это не лучший способ, но он ниже.Я не добавил часть удаления в последнюю, если потом, как я полагал, вы можете обработать это

Sub DeteteRows()
Dim rRange As Range
Dim bKeepFound As Boolean
bKeepFound = False
On Error Resume Next
Application.DisplayAlerts = False
Set rRange = Application.InputBox(Prompt:= _
"Please use mouse to select a row to Delete.", _
Title:="SPECIFY ROW TO DELETE", Type:=8)
On Error GoTo 0
    Application.DisplayAlerts = True
    If rRange Is Nothing Then
        Exit Sub
        'dont need the else statement cause you exit the sub if it fails
    End If

    For Each Row In rRange.Rows
    Dim s 'variable to hold the array
    s = Split(Row.Address, ":") 'split out the column and row
        'remove the $ and convert to a number then check the cell value
        If rRange.Cells(CInt(Replace(s(0), "$", "")), 12).Value = "keep" Then
            bKeepFound = True
        End If
    Next Row
    'check to see if a row was found to keep
    If bKeepFound Then
        Exit Sub 'row was found so exit sub
    Else
        'delete the rows in the range
    End If

End Sub