Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Подтянуть данные в столбец из другого листа, с условием, Ускорить расчет формулы или макрос
 
#1
26.06.2014 11:31:58
Добрый день, планета Excel!
Помогите в решении задачи (пример во вложении):
Необходимо подтянуть данные в столбец "Марка провода" из листа "Компоненты" с условием :
1. Если в пролете используется 1 провод, то =Название компонента, т.е. одножильный провод.
2. Если провода больше одного, то =сцепить("провод"; кол-во проводов;"х"; название компонента1).
Сложность формулы в том, что при большом кол-ве данных (кол-во пролетов бывает до 200тыс., а компонентов до 900тыс.) расчет длится очень долго. Помогите ускорить расчет формулы! Быть может возможно вычисление макросом вместо формулы? Помогите написать макрос.
Формула в виде:
=ЕСЛИ(СЧЁТЕСЛИ(Компоненты!$A$2:$A$443;A3)=1;ИНДЕКС(Компоненты!$C$2:$C$443;ПОИСКПОЗ(A3;Компоненты!$A$2:$A$443;0));СЦЕПИТЬ("Провод ";СЧЁТЕСЛИ(Компоненты!$A$2:$A$443;A3);"х";ИНДЕКС(Компоненты!$D$2:$D$443;ПОИСКПОЗ(A3;Компоненты!$A$2:$A$443;0))))
Изменено: Pavlin - 26.06.2014 14:17:13
 
 
 
#2
27.06.2014 07:55:00
Лучше всего для ускорения - изменить исходные данные.
Например, напрашивается (если невозможно изменить количество столбцов) в столбце "Название компонента 1" на листе "Компоненты" вывести количество используемых проводов, затем заменить его на значение и убрать дубликаты. Тогда можно в каждой ячейке не считать 2 раза количество пролетов, а посчитать 1 раз и в другом месте.
Если можно создать дополнительный столбец(столбцы), то см. файл. Еще упростит, если при этом вставить значения и убрать дубликаты.
Макросом тоже можно :)
F1 творит чудеса
 
 
 
#3
27.06.2014 09:38:03
Макросом на словаре не сложно - сперва пробежать по компонентам и собрать словарь (или можно два, что проще и думаю будет быстрее работать) с названием и количеством.
Затем циклом по пролётам берём из словаря что собрали.
Быстро на любом количестве.

Всего делов:

Код
Sub tt()
    Dim a(), i&, cDic As Object, nDic As Object

    Set cDic = CreateObject("Scripting.Dictionary"): cDic.comparemode = 1
    Set nDic = CreateObject("Scripting.Dictionary"): nDic.comparemode = 1

    a = Sheets("Компоненты").[a1].CurrentRegion.Value
    For i = 2 To UBound(a)
        If Not cDic.exists(a(i, 1)) Then cDic.Item(a(i, 1)) = a(i, 4)
        nDic.Item(a(i, 1)) = nDic.Item(a(i, 1)) + 1
    Next

    a = Sheets("Пролеты").[a1].CurrentRegion.Value
    For i = 3 To UBound(a)    'по месту!!!
        If nDic.Item(a(i, 1)) = 1 Then
            a(i, 3) = "Провод " & cDic.Item(a(i, 1))
        Else
            a(i, 3) = "Провод " & nDic.Item(a(i, 1)) & "х" & cDic.Item(a(i, 1))
        End If
    Next

    Sheets("Пролеты").[a1].CurrentRegion.Value = a
End Sub
Изменено: Hugo - 27.06.2014 09:55:20
 
 
 
#4
27.06.2014 16:59:29
Hugo, спасибо буду разбираться. Посмотрим как будет работать!
 
 
 
#5
30.06.2014 08:25:09
hohlick, да, упростит формулу данное решение!
 
 
 
#6
30.06.2014 10:46:08
Hugo , понимаю, что ничего не понимаю в макросах.
Но, не могли бы коротко пояснить, чтобы у себя применить, в случае если кол-во столбцов разное
Изменено: Pavlin - 30.06.2014 10:46:28
 
 
 
#7
30.06.2014 10:52:05
Если количество столбцов не такое, как в примере - меняйте в коде цифры в a(i, n).
Это если коротко. Если длинно - то нужно начинать с азов...
 
 
 
#8
30.06.2014 11:09:59
Hugo, помогите, пожалуйста, в этом примере как будет выглядеть код? Далее, кол-во строк только прибавится
 
 
 
#9
30.06.2014 11:31:38
Проверяйте:

Код
Sub tt()
    Dim a(), b(), i&, cDic As Object, nDic As Object

    Set cDic = CreateObject("Scripting.Dictionary"): cDic.comparemode = 1
    Set nDic = CreateObject("Scripting.Dictionary"): nDic.comparemode = 1

    a = Sheets("Материалы").[a1].CurrentRegion.Value
    For i = 2 To UBound(a)
        If Not cDic.exists(a(i, 1)) Then cDic.Item(a(i, 1)) = a(i, 4)
        nDic.Item(a(i, 1)) = nDic.Item(a(i, 1)) + 1
    Next

    a = Sheets(1).[a1].CurrentRegion.Columns(2).Value
    b = Sheets(1).[a1].CurrentRegion.Columns(9).Value
    For i = 2 To UBound(a)    'по месту!!!
        If nDic.exists(a(i, 1)) Then
            If nDic.Item(a(i, 1)) = 1 Then
                b(i, 1) = "Провод " & cDic.Item(a(i, 1))
            Else
                b(i, 1) = "Провод " & nDic.Item(a(i, 1)) & "х" & cDic.Item(a(i, 1))
            End If
        End If
    Next

    Sheets(1).[a1].CurrentRegion.Columns(9).Value = b
End Sub
Количество строк роли не играет.
Изменено: Hugo - 30.06.2014 11:32:14
 
 
 
#10
30.06.2014 11:47:03
Hugo, работает! В поле марка провода, содержащей 280тыс. строк,  потдягивает данные из листа с количеством строк 930 тыс. за примерно 30-40 сек !!!
Знание  - это сила! Благодарю!!!
 
 
 
#11
30.06.2014 12:03:55
Сразу нужно было говорить про такое количество - я бы ещё информацию в статусбар приладил, чтоб видеть что процесс идёт (40 секунд - всёж есть время закрасться сомнению - а не висит ли? )
Позже чуть подправлю, как время будет..

Попробуйте так - ещё чуть сэкономил память:
Скрытый текст
Изменено: Hugo - 30.06.2014 12:11:43
 
 
 
#12
30.06.2014 12:20:37
Цитата
Hugo пишет: я бы ещё информацию в статусбар приладил, чтоб видеть что процесс идёт
Было бы круто! Да, действительно, в первый момент насторожился
 
 
 
#13
30.06.2014 12:24:31
Выше добавил код.
Статусбар - это полоса в самом низу таблицы, там где изначально написано "Ready" (ну или что там в русском, не помню - вероятно "Готово"?)
 
 
 
#14
30.06.2014 12:27:26
Цитата
Hugo пишет:
Попробуйте так - ещё чуть сэкономил память:
Посчитал за сек. 70. (значит в первый раз он считал тоже не меньше).  В этот раз Excel зависал типа "не отвечает".
 
 
 
#15
30.06.2014 12:40:00
Вообще статусбар тоже потребляет процессорное время - поэтому я только каждую тысячную строку обрабатываю, чтоб только чуть затормозить процесс.
Почему зависает - не знаю, по идее не должно. Но вообще задача объёмная, всё может быть...
Если первый вариант работает стабильнее - используйте первый вариант. Хотя странно, во втором по идее меньше памяти используется, а статусбар не такое уж обременение...
 
 
 
#16
30.06.2014 13:21:21
Hugo, как изменить данное условие:
Код
If nDic.Item(a(i, 1)) = 1 Then
          b(i, 1) = "Провод " & cDic.Item(a(i, 1))
      Else
          b(i, 1) = "Провод " & nDic.Item(a(i, 1)) & "х" & cDic.Item(a(i, 1))
на:
Код
If nDic.Item(a(i, 1)) = 1 Then
          b(i, 1) = "Название компонента"
      Else
          b(i, 1) ="Название компонента 1" & nDic.Item(a(i, 1)) & "х" & "Название компонента 2"
Т.е. если в пролете компонент встречается только 1 раз, то само "Название компонента", если нет, то сцепить (назв. компонента 1; кол-во компонента; "х"; назв. комп 2) . Так как встречается не только провод, но и кабель.
Изменено: Pavlin - 30.06.2014 13:50:28
 
 
 
#17
30.06.2014 13:34:49
Вот почему сразу не показать реальную задачу? Сейчас код в третий раз изменю - но порядок в коде наводить уже не буду, сами виноваты...

Скрытый текст
и не важно, кабель там или что...
Проверьте - так хотели? Потому что я не понял, как хотели :(
Изменено: Hugo - 30.06.2014 13:39:41
 
 
 
#18
30.06.2014 13:46:02
Hugo, все верно, но вот это условие нельзя исправить, т.е оставить название как есть, без сцепления?

Код
If nDic.Item(a(i, 1)) = 1 Then
                b(i, 1) = cDic2.Item(a(i, 1)) & " " & cDic.Item(a(i, 1))
 
 
 
#19
30.06.2014 14:38:48
Можно что-то такое сообразить, но зачем?
Тогда для значений, которых больше одного - нужно сцеплять название1 и название2, а для тех, кто 1 - писать название0. Т.е нужно в код внедрять ещё один словарь. Ну внедряйте, если Вам заняться нечем...
 
 
 
#20
30.06.2014 14:56:30
Понял, в общем тема раскрыта, а остальное мелочи. Спасибо.
 
 
 
#21
30.06.2014 16:10:16
Вообще-то можно всё делать на одном словаре - так я в начале и планировал, но чтоб код был проще - сделал два словаря. Теперь уже три, далее четыре...  :(
Если изменить изначальный подход - сохранять в словаре номер строки массива, где встречен ключ, и там же собирать суммы (хотя для сумм всёж лучше другой словарь или массив) - то памяти затратится больше, а словарей меньше.
 
 
 
#22
01.07.2014 04:42:48
Hugo, добрый день!
Возможно подскажите по моему условному примеру. Имеется сводная таблица по вертикали фамилии, по горизонтали даты. Нужно на другом листе (1) собрать повторяющиеся фамилии в одну и (2) сложить при совпадении значения в соответствующих датах. Второе я сделал, первое пока не соображу какую формулу применить.
Массив данных по вертикали будет около 2-3 тысяч строк. Поэтому потребовалась формула.
В файле 2 листа, 1 лист исходные данные (Свод), на 2 листе (Итог) то, что хочу получить.
 
 
 
#23
01.07.2014 09:35:52
Если нужны формулы - то используйте СУММПРОИЗВ(). Или кажется массивную СУММЕСЛИ() - но я не формулист, могу ошибаться.
Да у Вас ведь уже сделано формулами...
Ну а если делать макросом - массивы-словари, или SQL
На большом количестве конечно макросом будет легче файл, и быстрее получите результат.

P.S. Как выбрать уникальные файмилии - на форуме были примеры формул, я правда подсказывать не берусь.
Я обычно делаю макросом, ну или что мешает вручную удалить дубликаты?
Изменено: Hugo - 01.07.2014 09:41:02
 
 
 
#24
01.07.2014 09:40:58
массивная:
Код
 =ИНДЕКС(Свод!B$3:B$8;НАИМЕНЬШИЙ(ЕСЛИ(ПОИСКПОЗ(Свод!B$3:B$8;Свод!B$3:B$8;0)=СТРОКА($1:$6);СТРОКА($1:$6));СТРОКА(B1)))
для D4 массивная не нужна (если пример реальный)
Код
=СУММЕСЛИ(Свод!$B$3:$B$8;$B4;Свод!D$3:D$8)
Изменено: Nic70y - 01.07.2014 09:43:54
 
 
 
#25
02.07.2014 10:32:14
Спасибо большое всем!
Протянул свою формулу на весь объём. Объём оказался в 45 000 ячеек. Эксель при изменении одной ячейки пересчитывал мне все ячейки около 40 минут.
Попробую применить ваши формулы. По фамилиям искал, возможно не так задавал поиск.
Ещё сейчас понадобилась автоматическая сортировка первого столбца по алфавиту. Но чтобы сортировка была не одной ячейки, а построчно.
 
 
 
Страницы: 1
Наверх