Добрый день. На лист 2 в столбец деталь необходимо вывести все детали которые содержат изделия в столбце Изделие на Лист2 Данные берутся с Листа 1
Добрый день. На лист 2 в столбец деталь необходимо вывести все детали которые содержат изделия в столбце Изделие на Лист2 Данные берутся с Листа 1kiv3383
массивная формула будет. и тяжелая для вычислений. реальные-то объемы больше, чать?
макрос
[vba]
Код
Sub t() Dim a(), d1, d2 Set d1 = CreateObject("scripting.dictionary") Set d2 = CreateObject("scripting.dictionary") With Sheets("Лист2") a = .Range(.[a2], .Cells(.Rows.Count, 1).End(xlUp)).Value For Each x In a: d1.Item(x) = 0&: Next With Sheets("Лист1") a = .Range(.[a2], .Cells(.Rows.Count, 2).End(xlUp)).Value For i = 1 To UBound(a) If d1.exists(a(i, 1)) Then d2.Item(a(i, 2)) = 0& Next End With If d2.Count Then .[b2].Resize(d2.Count).Value = Application.Transpose(d2.keys) End With End Sub
массивная формула будет. и тяжелая для вычислений. реальные-то объемы больше, чать?
макрос
[vba]
Код
Sub t() Dim a(), d1, d2 Set d1 = CreateObject("scripting.dictionary") Set d2 = CreateObject("scripting.dictionary") With Sheets("Лист2") a = .Range(.[a2], .Cells(.Rows.Count, 1).End(xlUp)).Value For Each x In a: d1.Item(x) = 0&: Next With Sheets("Лист1") a = .Range(.[a2], .Cells(.Rows.Count, 2).End(xlUp)).Value For i = 1 To UBound(a) If d1.exists(a(i, 1)) Then d2.Item(a(i, 2)) = 0& Next End With If d2.Count Then .[b2].Resize(d2.Count).Value = Application.Transpose(d2.keys) End With End Sub
Формулой в одну ячейку список поместить проблематично.
Все детали выводятся в столбец В. Тоже пробовал ИНДЕКСом, но вывести детали получается только по одному условию(изделию). Решение ikki, пока самое удачное. Но интересно формулой попробовать...
Формулой в одну ячейку список поместить проблематично.
Все детали выводятся в столбец В. Тоже пробовал ИНДЕКСом, но вывести детали получается только по одному условию(изделию). Решение ikki, пока самое удачное. Но интересно формулой попробовать...kiv3383
кстати. забыл уточнить: если у Вас будут встречаться одни и те же детали для разных изделий, то сколько раз выводить такую деталь? сейчас макрос выводит уникальные наименования деталей.
кстати. забыл уточнить: если у Вас будут встречаться одни и те же детали для разных изделий, то сколько раз выводить такую деталь? сейчас макрос выводит уникальные наименования деталей.ikki
помощь по Excel и VBA ikki@fxmail.ru, icq 592842413, skype alex.ikki
кстати. забыл уточнить: если у Вас будут встречаться одни и те же детали для разных изделий, то сколько раз выводить такую деталь? сейчас макрос выводит уникальные наименования деталей.
Сколько раз встречаются, столько и выводить, не могли бы Вы исправить, а то я не разбираюсь в макросах. Заранее спасибо.
кстати. забыл уточнить: если у Вас будут встречаться одни и те же детали для разных изделий, то сколько раз выводить такую деталь? сейчас макрос выводит уникальные наименования деталей.
Сколько раз встречаются, столько и выводить, не могли бы Вы исправить, а то я не разбираюсь в макросах. Заранее спасибо.kiv3383
Sub t() Dim a(), d1, b(), i&, j& Set d1 = CreateObject("scripting.dictionary") With Sheets("Лист2") a = .Range(.[a2], .Cells(.Rows.Count, 1).End(xlUp)).Value For Each x In a: d1.Item(x) = 0&: Next With Sheets("Лист1") a = .Range(.[a2], .Cells(.Rows.Count, 2).End(xlUp)).Value ReDim b(1 To UBound(a), 1 To 1) For i = 1 To UBound(a) If d1.exists(a(i, 1)) Then j = j + 1: b(j, 1) = a(i, 2) Next End With If j Then .[b2].Resize(j).Value = b End With End Sub
[/vba]
[vba]
Код
Sub t() Dim a(), d1, b(), i&, j& Set d1 = CreateObject("scripting.dictionary") With Sheets("Лист2") a = .Range(.[a2], .Cells(.Rows.Count, 1).End(xlUp)).Value For Each x In a: d1.Item(x) = 0&: Next With Sheets("Лист1") a = .Range(.[a2], .Cells(.Rows.Count, 2).End(xlUp)).Value ReDim b(1 To UBound(a), 1 To 1) For i = 1 To UBound(a) If d1.exists(a(i, 1)) Then j = j + 1: b(j, 1) = a(i, 2) Next End With If j Then .[b2].Resize(j).Value = b End With End Sub