Свод - лист, на котором отражены все материалы производства
Спецификация - лист, в котором макросом создается спецификация
Логика работы макроса: на листе СВОД - тысячи позиций (в примере всего пара сотен), которые группированы по типу- по Товарной группе (столбец "AH"). Если перейти в лист "Спецификация" и выбрать в ячейке "F3" наименование товарной группы - начнется заполнение спецификации. Но, т.к. позиций ну очень много - процесс затягивается и может даже подвиснуть файл. К тому же не знаю как реализовать "Умный" выпадающий список товарной группы в ячейке "F3", из-за этого выбор нужной товарной группы вызывает дискомфорт..
В чем требуется помощь:
Оптимизировать/ускорить/упростить работу макроса
Добавить умный выпадающий список в ячейку F3 листа "Спецификация"
Maxim, здравствуйте! Для поиска или выполнения иных агрегаций "по ключу" наиболее уместно использовать словари. Код вы не показали, поэтому не вижу, что у вас там, а скачивать и открывать файл желания нет.
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Jack Famous, я помогу тебе. Выкладываю код из файла ТС, который записан в файле в модуле листа Спецификация. В файле 2 листе "СВОД" и "Спецификация"
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim SVOD As Object, Spec As Object, LastRow_s&, LastRow_d&, r&, i&
If Target.Address = "$F$3" And Target.Text <> "" Then
Set SVOD = ThisWorkbook.Sheets("СВОД")
Set Spec = ThisWorkbook.Sheets("Спецификация")
LastRow_s = Spec.Range("E" & Rows.Count).End(xlUp).Row
Spec.Range("B5:H5").ClearContents 'Очищаем спецификацию
If LastRow_s > 8 Then Spec.Range("A6:A" & LastRow_s - 3).EntireRow.Delete ' 8 - количество столбцов спецификации ?!
LastRow_d = SVOD.Range("ah" & Rows.Count).End(xlUp).Row 'Выбираем столбец из вкладки Свод (товарная группа), по которой будет вестись сопоставление
r = 1
For i = 4 To LastRow_d
If SVOD.Range("ah" & i) = Spec.Range("F3") Then 'AH - адрес товарной группы, если наименование товарной группы совпадает с названием спецификации, то:
If r > 1 Then Rows(r + 4).Insert Shift:=xlUp: Spec.Range("A" & r + 3 & ":H" & r + 3).Copy: Spec.Range("A" & r + 4 & ":H" & r + 4).PasteSpecial Paste:=xlPasteFormats
Spec.Range("A" & r + 4) = r 'Пропускаем 4 строки шапки перед вставкой позиций (порядковый номер)
Spec.Range("B" & r + 4) = SVOD.Range("h" & i) ' "B" - куда вставляем "r+4" - пропуск 4 строк шапки / "B" - откуда вставляем "i" вставка последующих позиций
Spec.Range("C" & r + 4) = SVOD.Range("i" & i)
Spec.Range("D" & r + 4) = SVOD.Range("ar" & i)
Spec.Range("E" & r + 4) = SVOD.Range("k" & i)
Spec.Range("F" & r + 4) = SVOD.Range("at" & i)
Spec.Range("G" & r + 4) = SVOD.Range("y" & i)
Spec.Range("H" & r + 4) = SVOD.Range("z" & i)
r = r + 1
End If
Next i
End If
Application.ScreenUpdating = False
End Sub
Jack Famous написал: Maxim, здравствуйте! Для поиска или выполнения иных агрегаций "по ключу" наиболее уместно использовать словари. Код вы не показали, поэтому не вижу, что у вас там, а скачивать и открывать файл желания нет.
"код вы не показали" При публикации темы на форуме есть опция - загрузить файл, я его загрузил.Если нет желания - тогда вообще не пишите. Ленивый человек - деградирующий человек
New написал: Jack Famous, я помогу тебе. Выкладываю код из файла ТС, который записан в файле в модуле листа Спецификация. В файле 2 листе "СВОД" и "Спецификация"
Код
[URL=#]?[/URL] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 Private Sub Worksheet_Change( ByVal Target As Range) Dim SVOD As Object , Spec As Object , LastRow_s&, LastRow_d&, r&, i& If Target.Address = "$F$3" And Target.Text <> "" Then Set SVOD = ThisWorkbook.Sheets( "СВОД" ) Set Spec = ThisWorkbook.Sheets( "Спецификация" ) LastRow_s = Spec.Range( "E" & Rows.Count). End (xlUp).Row Spec.Range( "B5:H5" ).ClearContents 'Очищаем спецификацию If LastRow_s > 8 Then Spec.Range( "A6:A" & LastRow_s - 3).EntireRow.Delete ' 8 - количество столбцов спецификации ?! LastRow_d = SVOD.Range( "ah" & Rows.Count). End (xlUp).Row 'Выбираем столбец из вкладки Свод (товарная группа), по которой будет вестись сопоставление r = 1 For i = 4 To LastRow_d If SVOD.Range( "ah" & i) = Spec.Range( "F3" ) Then 'AH - адрес товарной группы, если наименование товарной группы совпадает с названием спецификации, то: If r > 1 Then Rows(r + 4).Insert Shift:=xlUp: Spec.Range( "A" & r + 3 & ":H" & r + 3).Copy: Spec.Range( "A" & r + 4 & ":H" & r + 4).PasteSpecial Paste:=xlPasteFormats Spec.Range( "A" & r + 4) = r 'Пропускаем 4 строки шапки перед вставкой позиций (порядковый номер) Spec.Range( "B" & r + 4) = SVOD.Range( "h" & i) ' "B" - куда вставляем "r+4" - пропуск 4 строк шапки / "B" - откуда вставляем "i" вставка последующих позиций Spec.Range( "C" & r + 4) = SVOD.Range( "i" & i) Spec.Range( "D" & r + 4) = SVOD.Range( "ar" & i) Spec.Range( "E" & r + 4) = SVOD.Range( "k" & i) Spec.Range( "F" & r + 4) = SVOD.Range( "at" & i) Spec.Range( "G" & r + 4) = SVOD.Range( "y" & i) Spec.Range( "H" & r + 4) = SVOD.Range( "z" & i) r = r + 1 End If Next i End If Application.ScreenUpdating = False End Sub
Спасибо за помощь, мне не сложно было бы сюда добавить код, если бы знал, что это удобно. Обычно все просят файл с примером. Всем не угодишь
Maxim написал: но ластиться перед хамами не собираюсь, потому что, в первую очередь, я уважаю себя и за словом в карман не полезу.
А что хамского Вы увидели в ответе Jack Famous, он даже Вам советы давал. А ТУТ Вы его даже благодарили
Если ничего не видите - то чем вас не устраивают мои манеры?! По поводу благодарности - "Даже вам советы давал" и "Даже благодарили" - на человеческие ответы - искренняя благодарность. Это не отменяет те факты, которые я ранее написал.
Maxim написал: то чем вас не устраивают мои манеры?!
Не понятна ваша агрессия. Вам дали совет:
Цитата
Jack Famous написал: Для поиска или выполнения иных агрегаций "по ключу" наиболее уместно использовать словари
, Вы вполне можете им воспользоваться и решить Вашу проблему, а то, что он не захотел скачивать файл это его право. Собственно, я тоже не всегда скачиваю файл если не понятно объяснение и в описании отсутствует код. Если код есть, сразу понятно, сможешь помочь или нет, стоит скачивать файл и подумать над решением ВАШЕЙ задачи или не стоит. К тому же, вот так помогаешь людям, а тебя в ответ деградантом называют, кому это будет приятно. Я думаю, что дальнейшая полемика ни к чему не приведёт, поэтому желаю Вам найти решение Вашей задачи. Удачи. И ещё, у Вас требуется комплексное решение задач, а это в платную ветку.
Maxim написал: то чем вас не устраивают мои манеры?!
Не понятна ваша агрессия. Вам дали совет:
Цитата
Jack Famous написал: Для поиска или выполнения иных агрегаций "по ключу" наиболее уместно использовать словари
, Вы вполне можете им воспользоваться и решить Вашу проблему, а то, что он не захотел скачивать файл это его право. Собственно, я тоже не всегда скачиваю файл если не понятно объяснение и в описании отсутствует код. Если код есть, сразу понятно, сможешь помочь или нет, стоит скачивать файл и подумать над решением ВАШЕЙ задачи или не стоит. К тому же, вот так помогаешь людям, а тебя в ответ деградантом называют, кому это будет приятно. Я думаю, что дальнейшая полемика ни к чему не приведёт, поэтому желаю Вам найти решение Вашей задачи. Удачи. И ещё, у Вас требуется комплексное решение задач, а это в платную ветку.
С чего вы взяли, что я это сказал с агрессией?! Если Вы и Ваш коллега такие чувствительные натуры, извиняться не собираюсь. Пишите друг дружке что вам лень делать и не мешайте своей перепиской (это я сейчас про Вас) другим пользователям форума, для этого есть флудилка. Посыл простой - в любой ситуации нужно оставаться человеком и уважительно общаться с окружающими. Про платную ветку понял, спасибо, готовлю ТЗ. Доброго Вам дня!
Maxim написал: в любой ситуации нужно оставаться человеком и уважительно общаться с окружающими
полностью согласен.
Цитата
Jack Famous написал: Код вы не показали, поэтому не вижу, что у вас там, а скачивать и открывать файл желания нет
Человек написал это как-то грубо и неуважительно? Он повел себя не как человек? Вроде тоже нет. С Вами поздоровались, дали совет как можно улучшить. Что неуважительного или бесчеловечного Вы лично увидели в том, что человек озвучил свою позицию как есть - кода нет, качать файл желания тоже нет. Это его право и ничего оскорбительно он в Ваш адрес не писал. Вы сами это для себя накрутили. И вот как раз-таки далее повели себя именно по-хамски:
Цитата
Maxim написал: Если нет желания - тогда вообще не пишите. Ленивый человек - деградирующий человек
т.е. назвали человека ленивым и деградирующим только потому, что он нагло и по хамски не захотел качать Ваш файл. Интересно. Jack Famous ничего в ответ на это не писал, но тем не менее Вы "за словом в карман не полезли":
Цитата
Maxim написал: ластиться перед хамами не собираюсь
А где же Вам тут кто-то чем-то нахамил? От Вас чего-то требовали, угрожали? Вам намекнули, что с приложенным листингом кода помощь придет быстрее. Но Вы в этом углядели неуважительное к себе отношение и более того - как видно даже хамское. Я вот сколько не читал - ничего подобного не увидел. Все не самые лестные высказывания в адрес другого участника принадлежат именно Вам... Сдается мне, что у Вас просто день не задался и в разгар этого всего Вам дали такой ответ, который Вас не устроил. Но это же не повод вести себя так, как повели себя Вы, правда? Перечитайте тему со стороны - кто больше Вам покажется хамом?
P.S. Кстати нежелание качать файлы с форума могут быть продиктованы многими причинами. Там могут быть вирусы, например. А у кого-то возможность качать файлы вообще заблокирована политикой компании.
Maxim: Если нет желания - тогда вообще не пишите. Ленивый человек - деградирующий человек…Попросил о помощи я нормально, но ластиться перед хамами не собираюсь, потому что, в первую очередь, я уважаю себя и за словом в карман не полезу
за такое можно и бан получить Чтоб вы понимали, "за словом в карман не полезу" и "оскорбляю людей в ответ на их нежелание бесплатно разбираться в моём вопросе, хотя они и дали правильный совет" - это не одно и то же))
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Maxim, хватит уже! Вы зашли на форум за помощью или поскандалить? Нек И не надо указывать, кому и что писать, а кому молчать. И не нужно походя обвинять в хамстве людей, которые Вам не хамили. Где Вы увидели хамство? Заодно пройдитесь по своим сообщениями и удалите избыточное цитирование. Например, гляньте #13 - это же форменное безобразие, а не цитата.