Страницы: 1 2 След.
RSS
Макрос (замена функции суммеслимн)
 
Уважаемые эксперты. Прошу помощи. Необходимо выполнить расчет, а именно найти значения - на листе "отчет№1" - используя массив данных с листа "база".
Искомые данные - это значения в столбцах "кол-во" и "сумма" в зависимости от условий ("дата" и "наименование")

Эта задача легко решается функцией "суммеслимн" и "суммпроизв", но к сожалению для большого массива данных на листе "база" - 800 тыс.строчек - мой ексель зависает как мертвый. Расчет выполнить невозможно. Прошу помочь заменить функцию - макросом. Пример "урезанный" - высылаю.
 
Цитата
ternovsky написал:
найти значения - на листе "отчет№1" - используя массив данных с листа "база".
КАКИЕ значения искать на этом листе? Вы бы показали желаемый результат хотя бы для 5 первых строк..
 
На листе отчет№1 в красных ячейках - вел формулу. Это результат который должен получится. Файл высылаю
 
Цитата
ternovsky написал:
найти значения - на листе "отчет№1"
Что искать на этом листе? И не вижу суммирования - просто вывод значений из базы по фамилии и дате. Суммирование где в примере?
 
Юрий М, В примере применена функция суммеслимн. Она суммирует. На листе "база" могут быть несколько строк с одинаковыми датами и наименованием и их надо суммировать.
Изменено: ternovsky - 04.06.2017 15:11:16
 
Цитата
Юрий М написал:
Что искать на этом листе?
Может в базе искать, а не в отчёте? Дважды ведь спросил.
И смущают заголовки столбцов: минимум и максимум. Смотрим в отчёте строку 13 (Абашкина Э.Р.) даты в столбцах мин. и макс. одинаковы, значения тоже. Почему для других фамилий не так?
 
Цитата
ternovsky написал:
На листе "база" могут быть несколько строк с одинаковыми датами и наименованием
В примере есть такие?
 
Юрий М, в примере таких нет, сильно его упростил. В оригинале на листе база - 800 тыс.строчек, а на листе отчет - 32тыс.строчек. 2 столбца - это крайние даты, самая первая и самая последняя - и только по ним нужны значения.
Изменено: ternovsky - 04.06.2017 15:45:51
 
ternovsky, Вы мои вопросы целиком читаете? ) Или выборочно?
 
Юрий М, целиком )) поможете?
 
Нет - ушёл из темы, так как не получил ответы на свои вопросы.
И пример не корректный.
 
Юрий М, я ответил изменив свой ответ. Прочитайте выше. Задача: заменить формулы на листе отчет - макросом
 
Эксперты, прошу помощи.
 
Даты внутри каждого ФИО уникальны?

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
JayBhagavan, на листе база - выгрузка из 1с, это реализация списком. В некоторые дни, по одному и томуже имени - может быть несколько операций (покупок).
На листе отчет - сумма кол-ва и сумма в рублях на выбранную дату по уникальному имени.
 
Вариант:
Код
Option Explicit

Sub tt()
    Dim a, b, d1 As Object, d2 As Object, i&, t$
    Set d1 = CreateObject("Scripting.Dictionary"): d1.CompareMode = 1
    Set d2 = CreateObject("Scripting.Dictionary"): d2.CompareMode = 1

    With Sheets("База")
        a = .UsedRange.Columns(5).Resize(, 2).Value
        b = .UsedRange.Columns(11).Resize(, 2).Value
    End With

    For i = 2 To UBound(a)
        t = a(i, 2) & "|" & a(i, 1)
        d1.Item(t) = d1.Item(t) + b(i, 1)
        d2.Item(t) = d2.Item(t) + b(i, 2)
    Next

    With Sheets("отчет№1")
        a = .UsedRange.Columns(1).Resize(, 4).Value
        b = .UsedRange.Columns(6).Resize(, 3).Value
    End With

    For i = 2 To UBound(a)
        t = a(i, 1) & "|" & a(i, 2)
        a(i, 3) = d1.Item(t)
        a(i, 4) = d2.Item(t)

        t = a(i, 1) & "|" & b(i, 1)
        b(i, 2) = d1.Item(t)
        b(i, 3) = d2.Item(t)
    Next

    With Sheets("отчет№1")
        .UsedRange.Columns(1).Resize(, 4).Value = a
        .UsedRange.Columns(6).Resize(, 3).Value = b
    End With

End Sub
Изменено: Hugo - 04.06.2017 19:22:09
 
Hugo,  спасибо. Включил макрос и ексель завис, или обрабатывает. Что еще можно сделать - чтобы увеличить работоспособность?
Изменено: ternovsky - 04.06.2017 20:33:21
 
Цитата
ternovsky написал:
Включил макрос и ексель завис,
вот так попробуйте:
Код
Option Explicit
 
Sub tt()
    Dim a, b, d1 As Object, d2 As Object, i&, t$
    Set d1 = CreateObject("Scripting.Dictionary"): d1.CompareMode = 1
    Set d2 = CreateObject("Scripting.Dictionary"): d2.CompareMode = 1
 
    With Sheets("База")
        a = .UsedRange.Columns(5).Resize(, 2).Value
        b = .UsedRange.Columns(11).Resize(, 2).Value
    End With
 
    For i = 2 To UBound(a)
        t = a(i, 2) & "|" & a(i, 1)
        DoEvents
        d1.Item(t) = d1.Item(t) + b(i, 1)
        d2.Item(t) = d2.Item(t) + b(i, 2)
    Next
 
    With Sheets("отчет№1")
        a = .UsedRange.Columns(1).Resize(, 4).Value
        b = .UsedRange.Columns(6).Resize(, 3).Value
    End With
 
    For i = 2 To UBound(a)
        t = a(i, 1) & "|" & a(i, 2)
        a(i, 3) = d1.Item(t)
        a(i, 4) = d2.Item(t)
 
        t = a(i, 1) & "|" & b(i, 1)
        b(i, 2) = d1.Item(t)
        b(i, 3) = d2.Item(t)
    Next
 
    With Sheets("отчет№1")
        .UsedRange.Columns(1).Resize(, 4).Value = a
        .UsedRange.Columns(6).Resize(, 3).Value = b
    End With
 
End Sub

Изменено: Михаил С. - 04.06.2017 20:50:05
 
Михаил С., перестал работать, теперь даже не зависает
 
Я не обратил внимание, что у меня английская раскладка была :)

Кстати, пояснения по макросу.
Как-то проверял скорость заполнения словаря в зависимости от количества Item.
Так вот, при превышении некоторого (тыс 100-200) Item Excel зависает....
Спасает всего лишь одна строчка: DoEvents перед или после нового значения.
 
Вообще макрос писался для конкретного файла, но с прицелом на то, что строк будет много (иначе можно было бы обойтись одним массивом, а не двумя).
Но на другом файле может быть Usedrange  растянута вообще на весь миллион строк, что не будет быстро...
Чтоб видеть что процесс идёт можно выводить в статусбар например каждый тысячный шаг, но это немного замедлит работу.
 
Эксперты, попробовал на примере (малой базе) - срабатывает мгновенно. Применяю к своему файлу - файл не висит, дает себя трогать - но при этом  нечего не происходит. Встает на функции doevents. Может надо подождать?
Изменено: ternovsky - 04.06.2017 21:20:41
 
Цитата
Hugo написал:
статусбар <...> немного замедлит работу
Игорь, а помнишь, в одной из тем (давненько это было) обнаружили, что в каком-то случае вывод информации в статустбар  даже немного ускорял работу?
 
Не, не помню. Может пропустил... Не должно вроде такого быть, ведь дополнительная работа будет делаться...
 
Да я тоже удивлялся )
 
Цитата
ternovsky написал:
Встает на функции doevents.
- это как определили? Пошагово пробовали гнать?
 
Hugo, поставил на паузу макрос и курсор отразился на этой строке. Я запускаю ваш макрос и ексель - зависает. Непонятно работает он или нет? подождать  или уже бесполезно..?? как понять??
Изменено: ternovsky - 04.06.2017 21:26:16
 
Цитата
ternovsky написал:
Встает на функции doevents.
Ну попробуйте перенести на две строчки ниже
 
Михаил С., попробовал - тоже встает =(
 
Попробуйте такой вариант. Если пойдёт - позже можно заменить 100 например на 1000
Код
Option Explicit

Sub tt()
    Dim a, b, d1 As Object, d2 As Object, i&, t$
    Set d1 = CreateObject("Scripting.Dictionary"): d1.CompareMode = 1
    Set d2 = CreateObject("Scripting.Dictionary"): d2.CompareMode = 1

    With Sheets("База")
        a = .UsedRange.Columns(5).Resize(, 2).Value
        b = .UsedRange.Columns(11).Resize(, 2).Value
    End With

    For i = 2 To UBound(a)
        t = a(i, 2) & "|" & a(i, 1)
        If i Mod 100 = 0 Then
            Application.StatusBar = "Заполнение словаря. Обработка строки " & i
            DoEvents
        End If
        d1.Item(t) = d1.Item(t) + b(i, 1)
        d2.Item(t) = d2.Item(t) + b(i, 2)
    Next

    With Sheets("отчет№1")
        a = .UsedRange.Columns(1).Resize(, 4).Value
        b = .UsedRange.Columns(6).Resize(, 3).Value
    End With

    For i = 2 To UBound(a)
        t = a(i, 1) & "|" & a(i, 2)
        If i Mod 100 = 0 Then
            Application.StatusBar = "Извлечение результатов. Обработка строки " & i
            DoEvents
        End If

        a(i, 3) = d1.Item(t)
        a(i, 4) = d2.Item(t)

        t = a(i, 1) & "|" & b(i, 1)
        b(i, 2) = d1.Item(t)
        b(i, 3) = d2.Item(t)
    Next

    With Sheets("отчет№1")
        .UsedRange.Columns(1).Resize(, 4).Value = a
        .UsedRange.Columns(6).Resize(, 3).Value = b
    End With

    Application.StatusBar = False
End Sub

P.S. Что-то у меня код из редактора копипастится на форум в одну строку (т.е. отображается на форуме), что за напасть? Приходится через блокнот копипастить...
Изменено: Hugo - 04.06.2017 22:14:27
Страницы: 1 2 След.
Наверх