Создание выпадающего списка, только если одна ячейка пуста

Question

Предположим, у меня есть каталог с формами (квадрат, круг, треугольник) и цветами (красный, синий, зеленый).Каждый продукт имеет свой уникальный код (SR = красный квадрат, TB = синий треугольник и т. Д.).В столбце A пользователь может ввести номер по каталогу, а в столбцах B и C - форму и цвет соответственно.

Я хочу, чтобы, если пользователь вводит номер по каталогу, то автоматически B и Cзаполнены (что я знаю, как сделать), или, в качестве альтернативы, если пользователь не вводит кошку.число, то у B и C есть выпадающие меню для выбора.

Я пытался создать функцию, которая делает это, но я не смог добиться успеха.

Вот что я делал:

Function DropDown(Clave As String)
    If Len(Clave) =0 Then
        With ActiveCell.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                xlBetween, Formula1:="=Shapes"
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
    Else
        'Code that finds the shape depending on Clave input
    End If
End Function

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

РЕДАКТИРОВАТЬ

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

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

РЕДАКТИРОВАТЬ 2

Я думал, что могуиспользуйте переключатель событий, который зависит от Cat.№ ячейки, чтобы решить вопрос.Например, предположим, что A1 является Cat.№ ячейкиЕсли пусто, то в B1 и C1 код макроса обнаруживает пустую ячейку и создает раскрывающиеся списки для форм и цветов соответственно.Когда пользователь вводит что-то в ячейку, средство изменения событий обнаруживает это, и макрос заполняет ячейки информацией о коде, поскольку он обнаруживает, что A1 больше не пуст.

Что вы, ребята, думаете?Я действительно мог бы использовать некоторые данные здесь.

Answer 1

Я закончил делать то, что предложил на РЕДАКТИРОВАТЬ 2 .

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Target.Worksheet.Range("A1")) Is Nothing Then
        If Range("A1") = "" Then
            Range("B1") = ""
            With Range("B1").Validation
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                     xlBetween, Formula1:="=Shapes"
                .IgnoreBlank = True
                .InCellDropdown = True
                .InputTitle = ""
                .ErrorTitle = ""
                .InputMessage = ""
                .ErrorMessage = ""
                .ShowInput = True
                .ShowError = True
            End With                
            Range("C1") = ""
            With Range("C1").Validation
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                    xlBetween, Formula1:="=Colors"
                .IgnoreBlank = True
                .InCellDropdown = True
                .InputTitle = ""
                .ErrorTitle = ""
                .InputMessage = ""
                .ErrorMessage = ""
                .ShowInput = True
                .ShowError = True
            End With
        Else
            Range("B1").Validation.Delete
            Range("C1").Validation.Delete
            Range("B1") = 'Code that searches the correct shape depending on A1.
            Range("B1") = 'Code that searches the correct color depending on A1.
        End If
    End If
End Sub

У кого-нибудь есть лучшее решение?