Страницы: 1
RSS
Возможно ли ускорить работу макроса с циклом?
 
Доброго времени суток.
Имеется выгрузка файла из interbase БД (gdb).
По каждому залоговому билету (столбец 4) проводятся операции выдачи кредита (код 2, столбец 6, описание операции в столбце 7), а также его возврату (код 11, столбец 6) либо инкассации (код 43, столбец 6)
Задача: проверить, что операции выдачи и возврата (инкассации) по залоговому билету с таким-то номером совпадают. Т.е. необходимо проверить, что сколько выдано, столько и возвращено. Если не совпадают, то данные выводятся на "Лист1".
Написал макрос (кнопка "Проверить"), но время работы занимает очень продолжительное время, учитывая, что строк на листе более 200 000 (двухсот тысяч).
Подскажите, пожалуйста, можно ли ускорить работу макроса?
Данные команды прирост в скорости не дают:
Код
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
Application.DisplayStatusBar = False
Application.DisplayAlerts = False
Изменено: Rustems - 26.03.2016 14:42:28
 
Если убрать в цикле совершенно не нужное Sheets("OPERZB").Select и чуть переписать, чтоб избавиться от  Sheets("Лист1").Select - то уже шевелится заметно быстрее.
Но вообще конечно на первый взгляд там можно ускорять чуть ли не каждую строку,  а лучше всё переписать на массивы и словарь
 
Может так? Не вполне правда понял по коду что нужно...
И вывожу только код и разницу - зачем там эти исходные? Да и не хотелось усложнять, поздно уже...
Код
Sub tt()
    Dim a, b, c, d, i&
    a = [Таблица1].Columns(4).Value
    b = [Таблица1].Columns(6).Value
    c = [Таблица1].Columns(33).Value
    d = [Таблица1].Columns(9).Value

    With CreateObject("scripting.dictionary"): .comparemode = 1
        For i = 1 To UBound(a)
            Select Case True
            Case b(i, 1) & c(i, 1) = "2"
                .Item(a(i, 1)) = .Item(a(i, 1)) + d(i, 1)
            Case b(i, 1) & c(i, 1) = "11"
                .Item(a(i, 1)) = .Item(a(i, 1)) - d(i, 1)
            Case Trim(b(i, 1)) = "43"
                .Item(a(i, 1)) = .Item(a(i, 1)) - d(i, 1)
            End Select
        Next
        ii = -1: a = Array(.keys, .items)
        For i = 1 To UBound(a(0))
            If a(1)(i) <> 0 Then
                ii = ii + 1: a(0)(ii) = a(0)(i): a(1)(ii) = a(1)(i)
            End If
        Next
    End With


    With Sheets("Лист1")
        .UsedRange.Offset(2).Clear
        If ii > -1 Then
            .[a3].Resize(ii + 1) = Application.Transpose(a(0))
            .[d3].Resize(ii + 1) = Application.Transpose(a(1))
        End If
    End With

    MsgBox "Проверка выполнена", vbInformation, "Внимание!"
End Sub
 
Спасибо большое. То, что надо. С массивами мне надо поучиться.
 
C 43 не вполне понял логику - так что перепроверьте, и конечно разберитесь в коде. Сейчас если 43 - то сумма отнимается, без других проверок.
 
С 43 Вы правильно понимаете. Это инкассация, что аналогично возврату (т. е. выдали кредит на 1000, должны сделать возврат либо инкассацию на 1000), поэтому, верно, необходимо отнимать. С кодом разбираюсь, т. к. до этого не имел дела с массивами.
Спасибо за помощь.
 
Тут основная "фишка" - использование словаря. Массивы - это только ускорение, можно и без них делать, ну будет всего лишь в 40 раз дольше...
 
Я заметил, что использование массива на порядок дает прирост скорости выполнения макроса.
Цитата
Hugo написал: И вывожу только код и разницу - зачем там эти исходные?
А чтобы вывести суммы выдачи и возврата, их нужно добавить в словарь?
 
Тогда проще в код добавить ещё два словаря - в одном собирать все выдачи, во втором все возвраты.
В итоге сформировать массив пошире, но выгружать/заполнять его надёжнее иначе - номера и результат можно как сейчас, а выдачи/возвраты извлекать индивидуально по каждому ключу-номеру.
Хотя вообще и результат тоже лучше бы индивидуально извлекать - т.к. расположение пар ключ-значение в словаре не гарантируется.
И вообще тогда можно обойтись двумя словарями - выдачи и возвраты, а в финале цикл по ключам и где разница не 0 - тех и выводим.
Но тогда код нужно почти весь переделывать.
Но переделывать некогда.
 
Цитата
Hugo написал:
можно обойтись двумя словарями - выдачи и возвраты
Чуть изменил код. Теперь выводятся выдачи и возвраты. Но не могу добиться, чтоб не выводились данные, если в 33 столбце есть какое-либо значение (т.е. в примере  №  300000013 не должен выводится, т.к. он считается удаленным). В самом макросе я расписал в чем загвоздка. Посмотрите, пожалуйста.
Изменено: Rustems - 26.03.2016 08:42:43
 
Ну накрутили :) Гдеж там чуть? Я в Вашем коде не разобрался, проще другой написать.
Всё ведь можно сделать намного проще, если создать для словаря переменную :)

Код
Option Explicit

Sub tt()
    Dim a, b, c, d, i&
    Dim d1 As Object, d2 As Object, k, razn As Double

    a = [Таблица1].Columns(4).Value
    b = [Таблица1].Columns(6).Value
    c = [Таблица1].Columns(33).Value
    d = [Таблица1].Columns(9).Value

    Set d1 = CreateObject("scripting.dictionary"): d1.comparemode = 1    ' для выдач
    Set d2 = CreateObject("scripting.dictionary"): d2.comparemode = 1    ' для возвратов
    For i = 1 To UBound(a)
        If Trim(c(i, 1)) = "" Then
            Select Case Trim(b(i, 1))
            Case "2"
                d1.Item(a(i, 1)) = d1.Item(a(i, 1)) + d(i, 1)    ' собираем выдачи
            Case "11", "43"
                d2.Item(a(i, 1)) = d2.Item(a(i, 1)) + d(i, 1)    ' собираем возвраты
            End Select
        End If
    Next

    ReDim a(1 To d1.Count, 1 To 4): i = 0    'экономим переменные :)
    For Each k In d1.keys    'перебор всех NZB
        razn = d1.Item(k) - d2.Item(k)    'разница выдача-возврат
        If razn <> 0 Then    'если разница не 0
            i = i + 1    'увеличивем индекс
            a(i, 1) = k    ' заносим NZB
            a(i, 2) = d1.Item(k)    ' заносим выдачу
            a(i, 3) = d2.Item(k)    ' заносим возврат
            a(i, 4) = razn    ' заносим разницу
        End If
    Next

    With Sheets("1")    'выводим на лист
        .[d1] = "ДОЛГ"    'это можно сделать один раз вручную :)
        .UsedRange.Offset(1).Clear
        If i > 0 Then .Cells(2, 1).Resize(i, 4) = a
    End With

    MsgBox "Проверка выполнена!", vbInformation, "Внимание!"

End Sub

Надеюсь таблица генерится скриптом, и там не будет в данных/ячейках никаких лишних пробелов, что часто любят тыркать бабки... :)
А то можно всюду навесить Trim()

P.S. Вообще в данном случае в словаре comparemode "рояли" не играет, т.к. там как ключи имеем числа, а не слова в разном регистре.
Кстати, если вдруг эти числа где-то будут текстом - это уже будет другой ключ, в таком случае нужно все ключи приводить к тексту, я обычно навешиваю Trim() - так получим текст, и от пробелов подстрахуемся. Но при выгрузке получим тоже текст... правда который в данном случае Эксель обратно превратит в число.
Изменено: Hugo - 26.03.2016 13:07:14 (оптимизировал код)
 
Цитата
Hugo написал:
Но при выгрузке получим тоже текст... правда который в данном случае Эксель обратно превратит в число.
Цитата
...кипит наш разум возмущенный....
Страницы: 1
Наверх