Запрет ввода данных, пока в столбце не введены данные

[belka]

Здравствуйте, уважаемые, помогите, пожалуйста, добавить к макросу, условие, которое бы запрещало вводить любые данные в строке, пока не заполнена ячейка в столбце F.
Я к сожалению знаю лишь, как прописать, что какая-то ячейка является пустой, то происходит событие, но здесь не фиксированная ячейка.

[belka]

Прописала, чтобы сначала столбец F заполняли, но теперь выводятся уведомления, вместо одного выходят два, а главное сам столбец F заблокирован

Код Выделить Развернуть

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
lr = Cells(Rows.Count, 6).End(xlUp).Row
bk = Cells(lr, 7) = "" And Cells(lr, 8) = "" And Cells(lr, 9) = "" And Cells(lr, 10) = "" And Cells(lr, 11) = "" And Cells(lr, 12) = "" And Cells(lr, 13) = "" And Cells(lr, 14) = "" And Cells(lr, 15) = "" And Cells(lr, 16) = "" And Cells(lr, 17) = "" And Cells(lr, 18) = "" And Cells(lr, 19) = "" And Cells(lr, 20) = "" And Cells(lr, 21) = ""
If Target.Row <> lr + 1 Then Exit Sub

If Cells(lr, 6) <> bk Then
MsgBox "Заполните столбец F"
Rows(lr).Select

If Not Cells(lr, 15) = "скидка" Then
If Cells(lr, 7) = "" Or Cells(lr, 10) = "" Or Cells(lr, 11) = "" Or Cells(lr, 15) = "" Then
MsgBox "Заполните предыдущую строку"
Rows(lr).Select
End If
End If
End If
End Sub

[kuklp1]

Может так:

Код Выделить Развернуть

Private Sub Worksheet_Change(ByVal Target As Range)
    lr = Cells(Rows.Count, 6).End(xlUp).Row
    If Target.Row <> lr + 1 Then Exit Sub
    If Not Cells(lr, 15) = "скидка" Then
        If Application.CountA(Range(Replace("G~,J~:K~,O~", "~", lr))) < 4 Then
            MsgBox "Заполните предыдущую строку"
        Else
            If Application.CountA(Range(Replace("n~,p~", "~", lr))) < 2 Then _
               MsgBox "Заполните предыдущую строку"
            Rows(lr).Select
        End If
    End If
End Sub

[belka]

kuklp1, нет так данные всё равно можно ввести.
Проблема решена, но осталась другая проблема нужно, чтобы, если в столбце 15 стоит слово скидка, тогда необходимо заполнить столбец 16 и 17, подскажите, пожалуйста, как это реализовать?

Код Выделить Развернуть

lr = Cells(Rows.Count, 6).End(xlUp).Row
If Target.Row <> lr + 1 Then Exit Sub
    If Not Cells(lr, 15) = "скидка" Then  ' если в столбце 15 слово "скидка", то разблокировать следующую строку - а нужно, что если введено слово скидка, то заполнить столбец 15 и 16
        If Cells(lr, 7) = "" Or Cells(lr, 10) = "" Or Cells(lr, 11) = "" Or Cells(lr, 15) = "" Then
        MsgBox "Заполните предыдущую строку"
        Rows(lr).Select
        Exit Sub
        End If
    End If

'   If Cells(lr, 15) = "скидка" Then         ' если в столбце 15 слово "скидка", то заполнить 16 и 17
'          If Cells(lr, 16) = "" Or Cells(lr, 17) = "" Then
'              MsgBox "Заполните предыдущую строку"
'              Rows(lr).Select
'      End If

If Target.Address <> Cells(Target.Row, 6).Address And Cells(Target.Row, 6).Value = "" Then
        MsgBox "Заполните столбец F"
        Cells(Target.Row, 6).Select
End If


[kuklp1]

Я не очень понимаю, чего Вы хотите. Вы пишете:

Код Выделить Развернуть

lr = Cells(Rows.Count, 6).End(xlUp).Row
If Target.Row <> lr + 1 Then Exit Subвот ввели вы в новой строке в столбце F слово "важно", lr у Вас будет равно Target.Row, поэтому Target.Row <> lr + 1, а значит Exit Sub. ИМХО это бессмыслица. Сработает она только если столбец F заполнять в последнюю очередь, но как правило заполнять принято слева-направо. Если так, то лучше lr определять по любой заполненной ячейке в строке правей F:

Код Выделить Развернуть

lr = Intersect(UsedRange, [g:p]).Find("*", [g1], xlFormulas, 1, 1, 2).Row Может так?

Код Выделить Развернуть

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lr&
    lr = Intersect(UsedRange, [g:p]).Find("*", [g1], xlFormulas, 1, 1, 2).Row
'    If Target.Row <> lr + 1 Then Exit Sub
    If Cells(lr, 15) = "скидка" Then
        If Application.CountA(Range(Replace("n~,p~", "~", lr))) < 2 Then
            MsgBox "Заполните предыдущую строку"
            Rows(lr).Select
        End If
    Else
        If Application.CountA(Range(Replace("G~,J~:K~,O~", "~", lr))) < 4 Then
            MsgBox "Заполните предыдущую строку"
            Rows(lr).Select
        End If
    End If
End Sub

[belka]

kuklp1, к сожалению Ваш макрос работает некорректно, после ввода данных не там, где нужно он всё равно оставляется данные.

[kuklp1]

Удален.

[kuklp1]

Из-за кроспостов ответ удаляю.
http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=1&TID=90016&TITLE_SEO=90016-blokirovanie-vvoda-dannykh
http://www.programmersforum.ru/showthread.php?t=306574