Блог

На первом листе у меня есть таблица под названием «Инвентарь», которая состоит из двух столбцов. В первом столбце содержатся все штрих-коды, а во Втором-Описание элемента.

Пример:

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

На данный момент я не столкнулся ни с какими проблемами, и все работает отлично.

Но некоторые штрих-коды имеют несколько разных описаний (как показано в примере со штрих-кодом «2222»), и я хочу иметь возможность изменить описание элемента с помощью выпадающего списка, в котором отображаются только разные элементы, имеющие один и тот же штрих-код.

Например, если я введу штрих-код «2222», в соседней ячейке появится «Пункт 2». Я хочу установить раскрывающийся список в ячейке описания, в котором будут отображаться пункт 2 и пункт 222, и выбрать тот, который я хочу.

Можете ли вы помочь мне решить эту проблему?

     Sub Data_Val()

    dim Inventory_Sheet, Out_Sheet as Worksheet

    set Inventory_sheet = Thisworkbook.worksheets("Inventory")
    set Out_Sheet = thisworkbook.worksheets("Out")

    Out_Sheet.activate

    Range("B2").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, _
         AlertStyle:=xlValidAlertStop, _
         Operator:=xlBetween, _
         Formula1:="='Inventory'!$B$2:$B$6"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    End Sub 
 

Пожалуйста, используйте следующий подход а:

1. В следующем коде требуется ссылка на «Среду выполнения сценариев Microsoft». С этим можно справиться и без него, используя позднюю привязку, но вы не воспользуетесь предложениями intellisense. Используйте следующий код, чтобы автоматически создать его:

 Sub addScrRunTimeRef()
  'Add a reference to 'Microsoft Scripting Runtime':
  'In case of error ('Programmatic access to Visual Basic Project not trusted'):
  'Options->Trust Center->Trust Center Settings->Macro Settings->Developer Macro Settings->
  '         check "Trust access to the VBA project object model"
  Application.VBE.ActiveVBProject.References.AddFromFile "C:WindowsSysWOW64scrrun.dll"
End Sub
 

Запустите код и сохраните книгу!

2. Создайте Public переменную в стандартном модуле:

 Public dictDescript As Scripting.Dictionary
 

3. Скопируйте следующий код в модуль кода листа «Инвентаризация» :

 Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range, arrT, i As Long
   Set rng = Me.ListObjects("Inventory").DataBodyRange
   If Not Intersect(Target, rng) Is Nothing Then
        Set dictDescript = New Scripting.Dictionary
        arrT = rng.value                      'to make code faster
        For i = 1 To UBound(arrT)
            'update the dictionary
            If Not dictDescript.Exists(arrT(i, 1)) Then
                dictDescript.Add arrT(i, 1), arrT(i, 2)
            Else
                dictDescript(arrT(i, 1)) = dictDescript(arrT(i, 1)) amp; "|" amp; arrT(i, 2)
            End If
        Next i
   End If
End Sub
 

Он обновит необходимый словарь, когда что-то будет изменено в таблице.

4. Скопируйте следующий код в модуль кода таблицы с сохранением «Вне».:

 Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim rngO As Range
   Set rngO = Me.ListObjects("Out").DataBodyRange.Columns(1)
   
   If Not Intersect(Target, rngO) Is Nothing Then
       If dictDescript Is Nothing Then 'if nothing has been placed in the dictionary:
            Dim rng As Range, arrT, i As Long, strCondition As String
            Set rng = Worksheets("Inventory").ListObjects("Inventory").DataBodyRange
            Set dictDescript = New Scripting.Dictionary
             arrT = rng.value                      'to make code faster
             For i = 1 To UBound(arrT)
                 'update the dictionary
                 If Not dictDescript.Exists(arrT(i, 1)) Then
                     dictDescript.Add arrT(i, 1), arrT(i, 2)
                 Else
                     dictDescript(arrT(i, 1)) = dictDescript(arrT(i, 1)) amp; "," amp; arrT(i, 2)
                 End If
             Next i
        End If
       'return the validation list from the dictionary:
        strCondition = dictDescript(Target.value)
        If strCondition = "" Then  'if a wrong string has been inputed (not one of the barcodes in Inventory sheet)
            MsgBox Target.value amp; " barcode, does not exist in ""Inventory"" sheet...", vbInformation, _
                                                                                         "No appropriate barcode input"
            Target.Offset(0, 1).Validation.Delete: Target.Offset(0, 1).value = ""
            Exit Sub
        End If
        'create the validation:
        Target.Offset(0, 1).value = ""
        With Target.Offset(0, 1).Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=strCondition
            .IgnoreBlank = True
            .InCellDropdown = True
            .ShowInput = True
            .ShowError = True
        End With
    End If
End Sub
 

Поиграйте со своими штрих-кодами и отправьте несколько отзывов.