Страницы: 1
RSS
Медленно работает макрос подбора и подстановки значений
 
Здравствуйте!
Имеется документ, в нем 2 листа:
  1. Свод - лист, на котором отражены все материалы производства
  2. Спецификация - лист, в котором макросом создается спецификация
Логика работы макроса: на листе СВОД - тысячи позиций (в примере всего пара сотен), которые группированы по типу- по Товарной группе (столбец "AH").
Если перейти в лист "Спецификация" и выбрать в ячейке "F3" наименование товарной группы - начнется заполнение спецификации. Но, т.к. позиций ну очень много - процесс затягивается и может даже подвиснуть файл.
К тому же не знаю как реализовать "Умный" выпадающий список товарной группы в ячейке "F3", из-за этого выбор нужной товарной группы вызывает дискомфорт..

В чем требуется помощь:
  • Оптимизировать/ускорить/упростить работу макроса
  • Добавить умный выпадающий список в ячейку F3 листа "Спецификация"

Всем откликнувшимся - спасибо!
Изменено: Maxim - 11.07.2022 16:52:41
 
мне кажется комплексные задания у нас на форуме решают в разделе Работа
 
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
Изменено: New - 11.07.2022 17:32:30
 
Цитата
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&amp;, LastRow_d&amp;, r&amp;, i&amp;             If   Target.Address =   "$F$3"   And   Target.Text <>   ""   Then              Set   SVOD = ThisWorkbook.Sheets(  "СВОД"  )              Set   Spec = ThisWorkbook.Sheets(  "Спецификация"  )                           LastRow_s = Spec.Range(  "E"   &amp; Rows.Count).  End  (xlUp).Row              Spec.Range(  "B5:H5"  ).ClearContents                      'Очищаем спецификацию              If   LastRow_s > 8   Then   Spec.Range(  "A6:A"   &amp; LastRow_s - 3).EntireRow.Delete   ' 8 - количество столбцов спецификации ?!                           LastRow_d = SVOD.Range(  "ah"   &amp; Rows.Count).  End  (xlUp).Row    'Выбираем столбец из вкладки Свод (товарная группа), по которой будет вестись сопоставление              r = 1              For   i = 4   To   LastRow_d                  If   SVOD.Range(  "ah"   &amp; i) = Spec.Range(  "F3"  )   Then        'AH - адрес товарной группы, если наименование товарной группы совпадает с названием спецификации, то:                      If   r > 1   Then   Rows(r + 4).Insert Shift:=xlUp: Spec.Range(  "A"   &amp; r + 3 &amp;   ":H"   &amp; r + 3).Copy: Spec.Range(  "A"   &amp; r + 4 &amp;   ":H"   &amp; r + 4).PasteSpecial Paste:=xlPasteFormats                      Spec.Range(  "A"   &amp; r + 4) = r                        'Пропускаем 4 строки шапки перед вставкой позиций (порядковый номер)                      Spec.Range(  "B"   &amp; r + 4) = SVOD.Range(  "h"   &amp; i)      ' "B" - куда вставляем "r+4" - пропуск 4 строк шапки / "B" - откуда вставляем "i" вставка последующих позиций                      Spec.Range(  "C"   &amp; r + 4) = SVOD.Range(  "i"   &amp; i)                      Spec.Range(  "D"   &amp; r + 4) = SVOD.Range(  "ar"   &amp; i)                      Spec.Range(  "E"   &amp; r + 4) = SVOD.Range(  "k"   &amp; i)                      Spec.Range(  "F"   &amp; r + 4) = SVOD.Range(  "at"   &amp; i)                      Spec.Range(  "G"   &amp; r + 4) = SVOD.Range(  "y"   &amp; i)                      Spec.Range(  "H"   &amp; r + 4) = SVOD.Range(  "z"   &amp; i)                      r = r + 1                  End   If              Next   i          End   If          Application.ScreenUpdating =   False    End   Sub   
 

Спасибо за помощь, мне не сложно было бы сюда добавить код, если бы знал, что это удобно.
Обычно все просят файл с примером. Всем не угодишь
 
Цитата
Maxim написал:
Всем не угодишь
необходимость стараться угодить всем возникает когда очень нужно получить решение проблемы и время поджимает)
Изменено: Ігор Гончаренко - 12.07.2022 09:03:07
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Цитата
Maxim написал:
Если нет желания - тогда вообще не пишите. Ленивый человек - деградирующий человек
Ух ты, не плохая манера просить о помощи.
 
Цитата
Msi2102 написал:
Цитата
Maxim написал:
Если нет желания - тогда вообще не пишите. Ленивый человек - деградирующий человек
Ух ты, не плохая манера просить о помощи.
Попросил о помощи я нормально, но ластиться перед хамами не собираюсь, потому что, в первую очередь, я уважаю себя и за словом в карман не полезу.
 
Цитата
Maxim написал:
но ластиться перед хамами не собираюсь, потому что, в первую очередь, я уважаю себя и за словом в карман не полезу.
А что хамского Вы увидели в ответе Jack Famous, он даже Вам советы давал. А ТУТ Вы его даже благодарили
Изменено: Msi2102 - 12.07.2022 09:23:20
 
Цитата
Msi2102 написал:
Цитата
Maxim написал:
но ластиться перед хамами не собираюсь, потому что, в первую очередь, я уважаю себя и за словом в карман не полезу.
А что хамского Вы увидели в ответе Jack Famous, он даже Вам советы давал. А  ТУТ  Вы его даже благодарили
Если ничего не видите - то чем вас не устраивают мои манеры?!
По поводу благодарности - "Даже вам советы давал" и "Даже благодарили" - на человеческие ответы - искренняя благодарность. Это не отменяет те факты, которые я ранее написал.
 
Цитата
Maxim написал:
то чем вас не устраивают мои манеры?!
Не понятна ваша агрессия. Вам дали совет:
Цитата
Jack Famous написал:
Для поиска или выполнения иных агрегаций "по ключу" наиболее уместно использовать словари
, Вы вполне можете им воспользоваться и решить Вашу проблему, а то, что он не захотел скачивать файл это его право. Собственно, я тоже не всегда скачиваю файл если не понятно объяснение и в описании отсутствует код. Если код есть, сразу понятно, сможешь помочь или нет, стоит скачивать файл и подумать над решением ВАШЕЙ задачи или не стоит. К тому же, вот так помогаешь людям, а тебя в ответ деградантом называют, кому это будет приятно. Я думаю, что дальнейшая полемика ни к чему не приведёт, поэтому желаю Вам найти решение Вашей задачи. Удачи.
И ещё, у Вас требуется комплексное решение задач, а это в платную ветку.
 
Цитата
Msi2102 написал:
Цитата
Maxim написал:
то чем вас не устраивают мои манеры?!
Не понятна ваша агрессия. Вам дали совет:
Цитата
Jack Famous написал:
Для поиска или выполнения иных агрегаций "по ключу" наиболее уместно использовать словари
, Вы вполне можете им воспользоваться и решить Вашу проблему, а то, что он не захотел скачивать файл это его право. Собственно, я тоже не всегда скачиваю файл если не понятно объяснение и в описании отсутствует код. Если код есть, сразу понятно, сможешь помочь или нет, стоит скачивать файл и подумать над решением ВАШЕЙ задачи или не стоит. К тому же, вот так помогаешь людям, а тебя в ответ деградантом называют, кому это будет приятно. Я думаю, что дальнейшая полемика ни к чему не приведёт, поэтому желаю Вам найти решение Вашей задачи. Удачи.
И ещё, у Вас требуется комплексное решение задач, а это в платную ветку.
С чего вы взяли, что я это сказал с агрессией?!
Если Вы и Ваш коллега такие чувствительные натуры, извиняться не собираюсь.
Пишите друг дружке что вам лень делать и не мешайте своей перепиской (это я сейчас про Вас) другим пользователям форума, для этого есть флудилка.
Посыл простой - в любой ситуации нужно оставаться человеком и уважительно общаться с окружающими.
Про платную ветку понял, спасибо, готовлю ТЗ.
Доброго Вам дня!
 
Офф - а точно хам?
Изменено: Дмитрий(The_Prist) Щербаков - 12.07.2022 12:19:55
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Maxim, если никто бесплатно не поможет, могу платно вам написать макрос (ускорить ваш код)
 
Цитата
Maxim: Если нет желания - тогда вообще не пишите. Ленивый человек - деградирующий человек…Попросил о помощи я нормально, но ластиться перед хамами не собираюсь, потому что, в первую очередь, я уважаю себя и за словом в карман не полезу
за такое можно и бан получить
Чтоб вы понимали, "за словом в карман не полезу" и "оскорбляю людей в ответ на их нежелание бесплатно разбираться в моём вопросе, хотя они и дали правильный совет" - это не одно и то же))
Изменено: Jack Famous - 12.07.2022 16:34:56
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Цитата
Maxim написал:
Посыл простой - в любой ситуации нужно оставаться человеком и уважительно общаться с окружающими.
Неужели дошло, наконец?
 
Del
Изменено: New - 12.07.2022 16:37:20
 
Maxim,  хватит уже! Вы зашли на форум за помощью или поскандалить? Нек И не надо указывать, кому и что писать, а кому молчать.
И не нужно походя обвинять в хамстве людей, которые Вам не хамили. Где Вы увидели хамство?
Заодно пройдитесь по своим сообщениями и удалите избыточное цитирование. Например, гляньте #13 - это же форменное безобразие, а не цитата.
Страницы: 1
Наверх