Страницы: 1
RSS
При выборе материалов из списка с мультивбором подставить данные из второй таблицы
 
Доброго времени суток форумчане.

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

У меня есть выпадающий список с мультивыбором, но мне так же нужно, что бы в соседнюю ячейку наполнялись данные из соседних столбцов заданной таблицы.
Комментарии к файлу:
В книге 2 листа, на листе «Материалы» я создал таблицу «SERT».
На первом листе, я выбираю из первого столбца таблицы «SERT[Name]» материалы, а во второй нужно чтобы выпадали данные из второй таблицы «SERT[Pass]».
 
Sheriff, дд. вроде так...
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
    On Error Resume Next
    If Not Intersect(Target, Range("SERT[Name]")) Is Nothing And Target.Cells.Count = 1 Then
        Application.EnableEvents = False
        newVal = Target
        Application.Undo
        oldval = Target
        Set cell = Worksheets("Материал").Columns(1).Find(newVal)
        If Len(oldval) <> 0 And oldval <> newVal Then
            Target.Offset(0, 1) = Target.Offset(0, 1) & "; " & cell.Offset(0, 1)
            Target = Target & "; " & newVal
        Else
            Target.Offset(0, 1) = cell.Offset(0, 1)
            Target = newVal
            
        End If
        If Len(newVal) = 0 Then
        Target.ClearContents
        Target.Offset(0, 1).ClearContents
        End If
        Application.EnableEvents = True
    End If
End Sub
Изменено: Mershik - 14.08.2020 21:42:15
Не бойтесь совершенства. Вам его не достичь.
 
Mershik, Спасибо ОГРОМНОЕ!!!!
всё работает просто идеально ))))

Вопрос только, какая команда отвечает за внесение данных в столбец. Если мне нужно например не в D-столбец вносить данные, а в F?
 
Sheriff, .Offset(0, 1)
это смещение 0 - на ноль строк, а 1 на 1 столбец вправо. т.е. вам нужно заменить 1 на 3
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
    On Error Resume Next
    If Not Intersect(Target, Range("SERT[Name]")) Is Nothing And Target.Cells.Count = 1 Then
        Application.EnableEvents = False
        newVal = Target
        Application.Undo
        oldval = Target
        Set cell = Worksheets("Материал").Columns(1).Find(newVal)
        If Len(oldval) <> 0 And oldval <> newVal Then
            Target.Offset(0, 3) = Target.Offset(0, 3) & "; " & cell.Offset(0, 1)
            Target = Target & "; " & newVal
        Else
            Target.Offset(0, 3) = cell.Offset(0, 1)
            Target = newVal
            
        End If
        If Len(newVal) = 0 Then
        Target.ClearContents
        Target.Offset(0, 1).ClearContents
        End If
        Application.EnableEvents = True
    End If
End Sub
Изменено: Mershik - 14.08.2020 21:53:25
Не бойтесь совершенства. Вам его не достичь.
 
Mershik, Вот это круто!!!! СПАСИБО!  
 
Mershik, возникло несколько проблем при интеграции в мою форму. Не мог бы подсказать как их решить:

1. При удалении данных из ячейки, стираются данные и из ячейки справа;
2. Добавил в таблицу «SERT» слева столбец [Num], и всё перестало работать. Столбец удаляю, опять всё работает.
3. Автоматическое добавление в столбец нужно только при выборе материалов, при внесении данных в другие столбцы, соседние не должны изменяться.

Заранее, спасибо!
Изменено: Sheriff - 15.08.2020 13:47:28
 
Sheriff, 3 пункт ничего не понял
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
    On Error Resume Next
    If Not Intersect(Target, Range("SERT[Filtr_1]")) Is Nothing And Target.Cells.Count = 1 Then
        Application.EnableEvents = False
        newVal = Target
        Application.Undo
        oldval = Target
        Set cell = Worksheets("БАЗА").Columns(2).Find(newVal) ' число 1 это есть столбец в котором выбираем name есл меняется нужно это число менять
        If Len(oldval) <> 0 And oldval <> newVal Then
            Target.Offset(0, 1) = Target.Offset(0, 1) & "; " & cell.Offset(0, 1)
            Target = Target & "; " & newVal
        Else
            Target.Offset(0, 1) = cell.Offset(0, 1)
            Target = newVal
             
        End If
        If Len(newVal) = 0 Then
        Target.ClearContents
'        Target.Offset(0, 1).ClearContents если нужно очистить Подтверждающие документы если очистить Наименование материала
        End If
        Application.EnableEvents = True
    End If
End Sub
Изменено: Mershik - 15.08.2020 14:07:16
Не бойтесь совершенства. Вам его не достичь.
 
Mershik, по п.3: Если я вношу данные в любую ячейку, то у меня автоматом вносятся данные (или обновляются) данные ячейки справа. Когда я выбираю из списка материалы, то в ячейку справа должны подгружаться сертификаты, но когда я к примеру вношу данные в столбец другой, ячейки справа не должны изменяться... Как то так)).
 
Sheriff, в любую ячейку любого столбца?
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
    On Error Resume Next
    If Not Intersect(Target, Range("SERT[Filtr_1]")) Is Nothing And Target.Cells.Count = 1 Then
    If Target.Column <> 9 Then Exit Sub
        Application.EnableEvents = False
        newVal = Target
        Application.Undo
        oldval = Target
        Set cell = Worksheets("БАЗА").Columns(2).Find(newVal) ' число 1 это есть столбец в котором выбираем name есл меняется нужно это число менять
        If Len(oldval) <> 0 And oldval <> newVal Then
            Target.Offset(0, 1) = Target.Offset(0, 1) & "; " & cell.Offset(0, 1)
            Target = Target & "; " & newVal
        Else
            Target.Offset(0, 1) = cell.Offset(0, 1)
            Target = newVal
              
        End If
        If Len(newVal) = 0 Then
        Target.ClearContents
'        Target.Offset(0, 1).ClearContents если нужно очистить Подтверждающие документы если очистить Наименование материала
        End If
        Application.EnableEvents = True
    End If
End Sub

Изменено: Mershik - 15.08.2020 15:26:39
Не бойтесь совершенства. Вам его не достичь.
 
Mershik, Вот сейчас гораздо лучше... спасибо.
В строке 10 кода пишешь коммент, что число 1 изменяет столбец... Относительно чего сейчас 2?
У меня в таблице "SERT" шесть столбцов. Данные я выбираю из "SERT[Filtr_1" (это 4 столбец в таблице), в соседний столбец вносятся данные из таблицы "SERT[Filtr_2]"  ((это пятый столбец таблицы)... почему "2"? Откуда?
Если я изменяю на 3, то у меня данные ни какие не подгружаются... Мозг взрывается, не могу соответствие найти
 
Цитата
Sheriff написал:
В строке 10 кода пишешь коммент, что число 1 изменяет столбец
какого столбца?
Цитата
Sheriff написал:
Относительно чего сейчас 2?
относительно изменяемой ячейки и тогда и сейчас и всегда почитайте справку про offset
Не бойтесь совершенства. Вам его не достичь.
 
Mershik, а есть возможность в код добавить ещё столбец который будет накапливать данные из выпадающего списка.
Я пытаюсь отдельно ниже код прописать, но они конфликтуют. Вставляю в этот дополнительно, тоже ошибка...  
 
Прошу помощи, разобраться с кодом.
Вставил на другой лист, не могу настроить ((((
Страницы: 1
Наверх