Страницы: 1
RSS
Как сделать ячейки пустыми при вводе значения в другую ячейку?
 
Добрый день.
Задача простая: в заданном диапазоне ячеек при вводе значения в одну из них все остальные - пустые.
Но вот для ее решения у меня фантазии не хватает.
Пробовал через подсчет пустот, но я не могу заменить значение в ячейке на формулу. Ячейки активные.
Возможно ли как то задать дополнительные условия для ячеек, например, в другом листе??
Спасибо за внимание.

Во вложение проект документа. В ячейках, выделенных оранжевым цветом, необходимо при вводе значения в одну из них - делать пустой ячейку, заполненную ранее.  
Изменено: excited - 19.03.2018 19:43:51 (замечания модератора)
 
excited, добрый и Вам. А зачем выложили на форум защищенный файл?
Если в мире всё бессмысленно, — сказала Алиса, — что мешает выдумать какой-нибудь смысл? ©Льюис Кэрролл
 
Защищенные вроде как ячейки, а не сам документ.
Пароль: pet1
 
excited, то что Вы хотите, формулами не сделать. Но можно ограничить количество значений вводимых в диапазон. Больше одного значения в строке в массива B19:G24 не введете.
Изменено: Bema - 19.03.2018 19:58:55
Если в мире всё бессмысленно, — сказала Алиса, — что мешает выдумать какой-нибудь смысл? ©Льюис Кэрролл
 
Цитата
Bema написал:
то что Вы хотите, формулами не сделать
но можно макросом, если excited не против  :) Макрос для модуля листа
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, cl As Range, temp As Range
Dim i As Byte

Set rng = Union([B3:F3], [B10:G10], [B19:G24])
Set temp = Intersect(Target, rng)
    If temp Is Nothing Then GoTo er
Application.EnableEvents = 0
    For i = 1 To rng.Areas.Count
    Set temp = Intersect(Target, rng.Areas(i))
        If Not temp Is Nothing Then
            For Each cl In rng.Areas(i)
                If cl.Address <> Target.Address Then cl.ClearContents
            Next cl
        End If
    Next i

er:
Application.EnableEvents = 1
End Sub
Bema, а ТСу вроде только незащищённые нужны…
Изменено: Jack Famous - 20.03.2018 10:09:28
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Цитата
Jack Famous написал:
но можно макросом
Даже не сомневался ;)  
Если в мире всё бессмысленно, — сказала Алиса, — что мешает выдумать какой-нибудь смысл? ©Льюис Кэрролл
 
OFF: Bema, да я в продолжение ваших слов  :D
тип "формулами нельзя…" но можно макросом  :) ясен красен вы в курсе - да ещё и покороче код бы предложили и побыстрее  :D
Изменено: Jack Famous - 19.03.2018 21:38:46
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Off.
Цитата
Jack Famous написал:
да ещё и покороче код бы предложили
Нее Bema, на макруху  не пойдет. Он на светлой стороне силы :-)
По вопросам из тем форума, личку не читаю.
 
Цитата
Jack Famous написал:
да ещё и покороче код бы предложили и побыстрее  
Jack Famous, вот это клевета ;)
БМВ,  спасибо за поддержку 8)  
Если в мире всё бессмысленно, — сказала Алиса, — что мешает выдумать какой-нибудь смысл? ©Льюис Кэрролл
 
Прекрасный макрос. Спасибо!
 
Jack Famous,
Код
    For i = 1 To rng.Areas.Count
    If Not Intersect(Target, rng.Areas(i)) Is Nothing Then
        TVal = Target
        rng.Areas(i).ClearContents
        Target = TVal
       End If
    Next i
или совсем
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, RN As Range
Dim TVal
Set rng = Union([B3:F3], [B10:G10], [B19:G24])
If Not Intersect(Target, rng) Is Nothing Then
    Application.EnableEvents = 0
    For Each RN In rng.Areas
        If Not Intersect(Target, RN) Is Nothing Then
            TVal = Target
            RN.ClearContents
            Target = TVal
        End If
    Next
End If
Application.EnableEvents = 1
End Sub
Со мной Сила пребывает, но не так много.
Изменено: БМВ - 20.03.2018 17:35:06
По вопросам из тем форума, личку не читаю.
 
БМВ, точно! Намного логичнее (для данного случая) снести всё и вставлять заранее сохранённые)) спасибо  :idea:
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
excited, вариант решения от БМВ без макроса. Не очищает, а не даёт ввести (инструмент "проверка данных")  :idea:
Изменено: Jack Famous - 04.04.2018 17:42:35
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Страницы: 1
Наверх