Оптимизация кода

@timofeevd · Регистрация: 28.07.2013

Author24 — интернет-сервис помощи студентам

Есть ли у кого будет свободная минутка - подскажите, что можно изменить, чтобы уменьшить время выполнения.
В среднем время выполнения 3-5 минут.

Visual Basic

Private Sub CommandButton1_Click()
'процедура заполняет файл базовой информацией и по мере анализа дополняет недостающей
 
'очищаем таблицы
Call clear_all
 
Application.ScreenUpdating = False
If fakt = True And prognoz = False Then
'заполняем базовой информацией
    Call perenos_prodaji
    Call perenos_prjam
    Call perenos_const
    Call perenos_tovar
    Call perenos_conto91
    Call perenos_korr
'заполняет недостающую информацию по столбцам
    Call poisk_KD_KN
    Call poisk_KD_dogovor
    Call poisk_nomgroup
    Call poisk_KP_dogovor
    Call poisk_GN
    Call poisk_KSZ
    Call poisk_etap_rabota
Else
    Call zagruzka_prognoza
End If
 
 
 
Application.ScreenUpdating = True
ActiveWorkbook.Save
 
MsgBox "Формирование исходной информации завершено."
End
End Sub

Visual Basic

Sub zagruzka_prognoza()
'процедура загружает информацию для прогноза
'ФАКТ - по выбранной дате
'Взаиморасчеты по выбранной дате
'ПРОГНОЗ - накладных расходов
 
Dim i As Double, j As Double, z As Double
Dim wb_ft As Workbook, wb_ab As Workbook, wb_vr As Workbook, wb_kr As Workbook
Dim wb_dog As Workbook, wb_ng As Workbook, wb_zt As Workbook, wb_nr As Workbook
Dim m_ft(50000, 25), m_kr(50000, 25), m_vr(50000, 25), m_nr(50000, 25)
Dim d_x As Date, d_n As Date, d_k As Date
Dim q_ft As Double, q_vr As Double, q_kr As Double, q_nr As Double
Dim st As String
 
Set wb_ab = ActiveWorkbook
 
d_x = CDate(InputBox("Введите день ИКС. Последний день фактического периода включительно."))
 
If IsNull(d_x) Then
    MsgBox "Дата не введена", vbInformation
    Exit Sub
End If
 
d_n = DateSerial(DatePart("yyyy", d_x), 1, 1)
d_k = DateSerial(DatePart("yyyy", d_x), 12, 31)
 
'запись ФАКТа
Set wb_ft = Workbooks.Open(bd_ft)
wb_ft.Activate
wb_ft.Sheets(1).Select
i = 2
z = 1
While Cells(i, 1) <> ""
 
If Cells(i, 1) >= d_n And Cells(i, 1) <= d_x Then  ' фильтр: начальная и конечная дата
 
    For j = 1 To q_x
        m_ft(z, j) = wb_ft.Sheets(1).Cells(i, j)
    Next
 
z = z + 1
End If
 
i = i + 1
Wend
q_ft = z - 1
wb_ft.Close
 
'запись НАКЛАДНЫЕ РАСХОДЫ
Set wb_nr = Workbooks.Open(z_nr_pr)
wb_nr.Activate
wb_nr.Sheets("бд").Select
i = 2
z = 1
While Cells(i, 1) <> ""
 
If Cells(i, 1) > d_x And Cells(i, 1) <= d_k Then  ' фильтр: начальная и конечная дата
 
    For j = 1 To q_x
        m_nr(z, j) = wb_nr.Sheets("бд").Cells(i, j)
    Next
 
z = z + 1
End If
 
i = i + 1
Wend
q_nr = z - 1
wb_nr.Close
 
'запись КОРРЕКТИРОВОК
Set wb_kr = Workbooks.Open(z_kr)
wb_kr.Activate
wb_kr.Sheets(1).Select
i = 2
z = 1
While Cells(i, 1) <> ""
 
If Cells(i, 1) > d_x And Cells(i, 1) <= d_k Then  ' фильтр: начальная и конечная дата
 
    For j = 1 To q_x
        m_kr(z, j) = wb_kr.Sheets(1).Cells(i, j)
    Next
 
z = z + 1
End If
 
i = i + 1
Wend
q_kr = z - 1
wb_kr.Close
 
'запись ВЗАИМОРАСЧЕТОВ
Set wb_vr = Workbooks.Open(z_vr)
wb_vr.Activate
wb_vr.Sheets(1).Select
i = 2
z = 1
While Cells(i, 1) <> ""
 
If Cells(i, 1) > d_x And Cells(i, 1) <= d_k And Cells(i, 10) = "ДиР" And Cells(i, 13) <> "Компенсации" Then ' фильтр: начальная и конечная дата
 
    m_vr(z, 1) = Sheets(1).Cells(i, 1) 'дата
    m_vr(z, 2) = Sheets(1).Cells(i, 16) 'сумма без ндс
    
    Select Case Sheets(1).Cells(i, 9) 'вид
    Case "Приход"
        m_vr(z, 6) = "Доход"
    Case "Расход"
        m_vr(z, 6) = "Расход"
    End Select
    
    m_vr(z, 14) = Sheets(1).Cells(i, 14) 'регистратор
    m_vr(z, 15) = False '1С
    m_vr(z, 16) = Sheets(1).Cells(i, 3) 'код договора
    If Sheets(1).Cells(i, 3) <> "" Then
        m_vr(z, 17) = Sheets(1).Cells(i, 18) 'код номенклатурной группы
    End If
    m_vr(z, 21) = Sheets(1).Cells(i, 2) 'сумма с ндс
    m_vr(z, 22) = Sheets(1).Cells(i, 15) - 1 'ндс
    m_vr(z, 23) = Sheets(1).Cells(i, 11) 'признак
    m_vr(z, 24) = Sheets(1).Cells(i, 7) 'этап
    m_vr(z, 25) = Sheets(1).Cells(i, 8) 'работа
    
z = z + 1
End If
 
i = i + 1
Wend
q_vr = z - 1
wb_vr.Close
 
'поиск недостающей информации в справочникен Договора
Set wb_dog = Workbooks.Open(spr_dog)
wb_dog.Activate
wb_dog.Sheets(1).Select
For i = 1 To q_vr
    j = 2
    While Cells(j, 1) <> ""
        If m_vr(i, 16) = Cells(j, 1) Then
            m_vr(i, 20) = Cells(j, 8) 'код проекта
            m_vr(i, 4) = Cells(j, 9) 'проект
            m_vr(i, 7) = Cells(j, 2) 'контрагент
            m_vr(i, 8) = Cells(j, 3) 'договор
            m_vr(i, 18) = Cells(j, 17) 'код статьи затрат
            If m_vr(i, 17) = "" Then m_vr(i, 17) = Cells(j, 16) 'код номенклатурной группы
            j = 50000
        End If
    j = j + 1
    Wend
 
Next
'заполняем Заказчика
For i = 1 To q_vr
    j = 2
    While Cells(j, 1) <> ""
        If m_vr(i, 20) = Cells(j, 8) And Cells(j, 6) = "Контракты" Then
            m_vr(i, 3) = Cells(j, 2) 'заказчик
            j = 50000
        End If
    j = j + 1
    Wend
 
Next
wb_dog.Close
 
'поиск недостающей информации в справочникен Номенклатурные группы
Set wb_ng = Workbooks.Open(spr_ng)
wb_ng.Activate
wb_ng.Sheets(1).Select
For i = 1 To q_vr
    j = 2
    While Cells(j, 1) <> ""
        If m_vr(i, 17) = Cells(j, 1) Then
            m_vr(i, 5) = Cells(j, 2) 'номменклатурная группа
            m_vr(i, 12) = Cells(j, 3) 'направление
            If m_vr(i, 18) = "" Then
                m_vr(i, 18) = Cells(j, 6) 'код статьи затрат для проектов с не уникальной номм.группой
            End If
            j = 50000
        End If
    j = j + 1
    Wend
 
Next
wb_ng.Close
 
'поиск недостающей информации в справочнике Справочник статьи затрат
Set wb_zt = Workbooks.Open(spr_sz)
wb_zt.Activate
wb_zt.Sheets(1).Select
For i = 1 To q_vr
    j = 2
    While Cells(j, 1) <> ""
        If m_vr(i, 18) = Cells(j, 1) And Cells(j, 8) = "" Then
            m_vr(i, 9) = Cells(j, 4) 'категория
            m_vr(i, 10) = Cells(j, 3) 'группа статей
            m_vr(i, 11) = Cells(j, 2) 'статья
            j = 50000
        End If
    j = j + 1
    Wend
 
Next
wb_zt.Close
 
'ЗАПИСЬ В БАЗУ ДАННЫХ
wb_ab.Activate
'ФАКТ
Sheets(7).Select
i = 2
For i = 1 To q_ft
    For j = 1 To q_x
    
        Cells(i + 1, j) = m_ft(i, j)
        
    Next
Next
'КОРРЕКТИРОВКИ
Sheets(6).Select
i = 2
For i = 1 To q_kr
    For j = 1 To q_x
    
        Cells(i + 1, j) = m_kr(i, j)
        
    Next
Next
'ВЗАИМОРАСЧЕТЫ
Sheets(8).Select
i = 2
For i = 1 To q_vr
    For j = 1 To q_x
    
        Cells(i + 1, j) = m_vr(i, j)
        
    Next
Next
'НАКЛАДНЫЕ РАСХОДЫ
Sheets(3).Select
i = 2
For i = 1 To q_nr
    For j = 1 To q_x
    
        Cells(i + 1, j) = m_nr(i, j)
        
    Next
Next
 
End Sub

@~~Апострофф~~ · 12.08.2015, 16:49

timofeevd, при копировании кода переключитесь на рус. раскладку и повторите вброс, пожалуйста...

@Hugo121 · 12.08.2015, 22:57

Т.е. предлагаете по коду восстановить задачу и файл, и может быть придумать кучу процедур?
А вообще можно сразу сказать что нужно сделать чтоб ускорить - не перебирать отдельные ячейки листа, перейти на массивы, вместо кучи and использовать вложенные if-then.

@timofeevd · 13.08.2015, 08:24 **[ТС]**

Сообщение от Hugo121

Т.е. предлагаете по коду восстановить задачу и файл, и может быть придумать кучу процедур?

Нет.

Меня как раз интересовали совета из разряда, что Вы в частности привели:

Сообщение от Hugo121

вместо кучи and использовать вложенные if-then

Сообщение от Hugo121

не перебирать отдельные ячейки листа

- Это не занимает большое количество времени, т.к.объем строк для анализа небольшой примерно 45 000,
Большое количество времени занимает непосредственно вывод строк в итоговые таблицы Excel.

Сама задача следующая:
1. Из файлов источников забирает информацию по фильтру; храним в массиве
2. Открываем файлы-справочники и простым перебором заполняем недостающую информацию. В массив справочники не стал загонять, т.к.это при моих объемах на скорость сильно не влияет
3. Дополненную информацию вставляем в файл База данных для рисования отчетов, сводных таблиц и т.п.
4. Первый код указан только с точки зрения, чтобы показать что отключается/включается обновлению Excel

@Hugo121 · 13.08.2015, 08:55

Сообщение от timofeevd

- Это не занимает большое количество времени, т.к.объем строк для анализа небольшой примерно 45 000,

Да ладно не занимает...
Смотрите - вот тут
If Cells(i, 1) >= d_n And Cells(i, 1) <= d_x Then
возможно половина работы лишняя. И это чуть не в десяти местах (сбился со счёта...).
а тут
If Cells(i, 1) > d_x And Cells(i, 1) <= d_k And Cells(i, 10) = "ДиР" And Cells(i, 13) <> "Компенсации" Then
лишних проверок 3/4.
Причём это всё обращение к ячейкам.

Добавлено через 11 минут
По фильтру думаю можно сделать так: берём все исходные в массив, цикл по массиву - отобранное перекладываем в другой массив как у Вас, но в двумерный, чтоб выгружать быстро без цикла, а если памяти не хватает, то можно перекладыввать прямо в этом же вверх.
Думаю всё ускорится раз так в 30, а возможно если видеть задачу живьём то и в 100 раз можно ускорить (если например привлечь словари/коллекции). И ещё не видно что там в этих секретных perenos/poisk...

@timofeevd · 13.08.2015, 09:13 **[ТС]**

Сообщение от Hugo121

Да ладно не занимает...

Нет!

Hugo121 я про массив знаю, с этим не спорю и потом, конечно переделаю. Сейчас выйгрыш в 2-4 секунды мне не важен.
Если честно интересует больше сокращение времени по выводу информации на лист Excel и какие-нибудь еще полезности вроде замены and на вложенные if then.

Visual Basic

Sheets(3).Select
i = 2
For i = 1 To q_nr
    For j = 1 To q_x
    
        Cells(i + 1, j) = m_nr(i, j)
        
    Next
Next

Вот эта фигня и занимает большое количество времени.

Добавлено через 8 минут

Сообщение от Hugo121

И ещё не видно что там в этих секретных perenos/poisk..

Принцип тот же, только там я писал отдельно по процедурам (вначале проекта), а здесь все загнал в одну.
Буду переделывать все эти poisk и perenos в одну.
perenos/poisk - формирует базу данных по фактической информации (выгрузки из 1C)
zagruzka_prognoza - к сформированному факту добавляет прогноз.

SoftIce · 13.08.2015, 09:43

Сообщение от timofeevd

Вот эта фигня и занимает большое количество времени.

Так зачем перебирать все элементы в цикле?
Вываливайте сразу массив в Range

Visual Basic

1	Sheets(3).Range(Cells(2, 1), Cells(q_nr + 1, q_x)) = m_nr

@Hugo121 · 13.08.2015, 09:57

i = 2
For i = 1
зачем и=2?
А выгрузку из двумерного делают без цикла:

Visual Basic

1	cells(2,1).resize(ubound(arr,1), ubound(arr,2))=arr

Добавлено через 1 минуту
Ну или можно конкретно указать, сколько с верхнего левого угла массива вываливать.

@timofeevd · 13.08.2015, 12:20 **[ТС]**

Сообщение от Hugo121

i = 2
For i = 1
зачем и=2?

К...А...С...Я...К...!
Все остальное сейчас попробую.

Добавлено через 1 час 4 минуты

Сообщение от SoftIce

Sheets(3).Range(Cells(2, 1), Cells(q_nr + 1, q_x)) = m_nr

Выдает ошибку.
Run-time error '1004':
Application-defined or object-defined error

@Hugo121 · 13.08.2015, 12:25

Не указано чьи cells - если активный не Sheets(3), то будет ошибка.

@timofeevd · 13.08.2015, 12:31 **[ТС]**

Еще вопрос
При обращении к книгам, там где есть связи с другими книгами, идет запрос на обновление и потом на сохранение.
Как мне кодом игнорировать данные запросы?

@Hugo121 · 13.08.2015, 12:35

Visual Basic

1	ActiveWorkbook.UpdateLinks = xlUpdateLinksNever

Добавлено через 1 минуту
ещё есть

Visual Basic

1	Application.AskToUpdateLinks = False

В общем смотря по задаче.

@timofeevd · 17.08.2015, 16:20 **[ТС]**

Внес изменения согласно Ваших замечаний. Результат: менее 20 секунд.
Может еще что-то можно поменять?

И еще вопрос? Что в настройках файла я поменял? что он у меня постоянно запрашивает сохранение, даже если изменений не было.

Visual Basic

Sub zagruzka_prognoza()
'процедура загружает информацию для прогноза
'ФАКТ - по выбранной дате
'Взаиморасчеты по выбранной дате
'ПРОГНОЗ - накладных расходов
 
Dim i As Double, j As Double, z As Double
Dim wb_ft As Workbook, wb_ab As Workbook, wb_vr As Workbook, wb_kr As Workbook
Dim wb_dog As Workbook, wb_ng As Workbook, wb_sz As Workbook, wb_nr As Workbook
Dim m_ft(50000, 25), m_kr(50000, 25), m_vr(50000, 25), m_nr(50000, 25)
Dim m_spr_dog(5000, 10), m_spr_ng(1000, 7), m_spr_sz(200, 8)
Dim d_x As Date, d_n As Date, d_k As Date
Dim q_ft As Double, q_vr As Double, q_kr As Double, q_nr As Double
Dim st As String
 
Set wb_ab = ActiveWorkbook
 
d_x = CDate(InputBox("Введите день ИКС. Последний день фактического периода включительно."))
 
If IsNull(d_x) Then
    MsgBox "Дата не введена", vbInformation
    Exit Sub
End If
 
d_n = DateSerial(DatePart("yyyy", d_x), 1, 1)
d_k = DateSerial(DatePart("yyyy", d_x), 12, 31)
 
'запись ФАКТа
Set wb_ft = Workbooks.Open(bd_ft, 0)
wb_ft.Activate
wb_ft.Sheets(1).Select
i = 2
z = 0
While Cells(i, 1) <> ""
 
If Cells(i, 1) >= d_n And Cells(i, 1) <= d_x Then  ' фильтр: начальная и конечная дата
 
    For j = 1 To q_x
        m_ft(z, j - 1) = wb_ft.Sheets(1).Cells(i, j)
    Next
 
z = z + 1
End If
 
i = i + 1
Wend
q_ft = z - 1
wb_ft.Close
 
'запись НАКЛАДНЫЕ РАСХОДЫ
Set wb_nr = Workbooks.Open(z_nr_pr, 0)
wb_nr.Activate
wb_nr.Sheets("бд").Select
i = 2
z = 0
While Cells(i, 1) <> ""
 
If Cells(i, 1) > d_x And Cells(i, 1) <= d_k Then  ' фильтр: начальная и конечная дата
 
    For j = 1 To q_x
        m_nr(z, j - 1) = wb_nr.Sheets("бд").Cells(i, j)
    Next
 
z = z + 1
End If
 
i = i + 1
Wend
q_nr = z - 1
wb_nr.Close
 
'запись КОРРЕКТИРОВОК
Set wb_kr = Workbooks.Open(z_kr, 0)
wb_kr.Activate
wb_kr.Sheets(1).Select
i = 2
z = 0
While Cells(i, 1) <> ""
 
If Cells(i, 1) > d_x And Cells(i, 1) <= d_k Then  ' фильтр: начальная и конечная дата
 
    For j = 1 To q_x
        m_kr(z, j - 1) = wb_kr.Sheets(1).Cells(i, j)
    Next
 
z = z + 1
End If
 
i = i + 1
Wend
q_kr = z - 1
wb_kr.Close
 
'запись ВЗАИМОРАСЧЕТОВ
Set wb_vr = Workbooks.Open(z_vr, 0)
wb_vr.Activate
wb_vr.Sheets(1).Select
i = 2
z = 0
While Cells(i, 1) <> ""
 
If Cells(i, 1) > d_x And Cells(i, 1) <= d_k Then    ' фильтр: начальная и конечная дата
 
    If Cells(i, 10) = "ДиР" Then
    
        If Cells(i, 13) <> "Компенсации" Then
        
            m_vr(z, 0) = Sheets(1).Cells(i, 1) 'дата
            m_vr(z, 1) = CCur((Sheets(1).Cells(i, 16))) 'сумма без ндс
            Select Case Sheets(1).Cells(i, 9) 'вид
            Case "Приход"
                m_vr(z, 5) = "Доход"
            Case "Расход"
                m_vr(z, 5) = "Расход"
            End Select
            m_vr(z, 13) = Sheets(1).Cells(i, 14) 'регистратор
            m_vr(z, 14) = False '1С
            m_vr(z, 15) = Sheets(1).Cells(i, 3) 'код договора
            If Sheets(1).Cells(i, 3) <> "" Then
                m_vr(z, 16) = Sheets(1).Cells(i, 18) 'код номенклатурной группы
            End If
            m_vr(z, 20) = CCur(Sheets(1).Cells(i, 2)) 'сумма с ндс
            m_vr(z, 21) = Sheets(1).Cells(i, 15) - 1 'ндс
            m_vr(z, 22) = Sheets(1).Cells(i, 11) 'признак
            m_vr(z, 23) = Sheets(1).Cells(i, 7) 'этап
            m_vr(z, 24) = Sheets(1).Cells(i, 8) 'работа
            z = z + 1
        End If
        
    End If
    
End If
 
i = i + 1
Wend
q_vr = z - 1
wb_vr.Close
 
'ФОРМИРОВАНИЕ МАССИВОВ ИЗ СПРАВОЧНИКОВ
'СПРАВОЧНИК ДОГОВОРА
Set wb_dog = Workbooks.Open(spr_dog, 0)
i = 2
While wb_dog.Sheets(1).Cells(i, 1) <> ""
    m_spr_dog(i - 2, 0) = wb_dog.Sheets(1).Cells(i, 1) 'код договора
    m_spr_dog(i - 2, 1) = wb_dog.Sheets(1).Cells(i, 8) 'код проекта
    m_spr_dog(i - 2, 2) = wb_dog.Sheets(1).Cells(i, 9) 'проект
    m_spr_dog(i - 2, 3) = wb_dog.Sheets(1).Cells(i, 2) 'контрагент
    m_spr_dog(i - 2, 4) = wb_dog.Sheets(1).Cells(i, 3) 'договор
    m_spr_dog(i - 2, 5) = wb_dog.Sheets(1).Cells(i, 17) 'код статьи затрат
    m_spr_dog(i - 2, 6) = wb_dog.Sheets(1).Cells(i, 16) 'код номенклатурной группы
    m_spr_dog(i - 2, 7) = wb_dog.Sheets(1).Cells(i, 6) 'вид взаиморасчетов
    m_spr_dog(i - 2, 8) = wb_dog.Sheets(1).Cells(i, 2) 'заказчик
i = i + 1
Wend
q_spr_dog = i - 3
wb_dog.Close
'СПРАВОЧНИК НОМЕНКЛАТУРНЫЕ ГРУППЫ
Set wb_ng = Workbooks.Open(spr_ng, 0)
i = 2
While wb_ng.Sheets(1).Cells(i, 1) <> ""
 
    For j = 1 To 7
        m_spr_ng(i - 2, j - 1) = wb_ng.Sheets(1).Cells(i, j)
    Next
i = i + 1
Wend
q_spr_ng = i - 3
wb_ng.Close
'СПРАВОЧНИК СТАТЬИ ЗАТРАТ
Set wb_sz = Workbooks.Open(spr_sz, 0)
i = 2
While wb_sz.Sheets(1).Cells(i, 1) <> ""
 
    For j = 1 To 8
        m_spr_sz(i - 2, j - 1) = wb_sz.Sheets(1).Cells(i, j)
    Next
i = i + 1
Wend
q_spr_sz = i - 3
wb_sz.Close
 
'ПОИСК НЕДОСТАЮЩИЙ ИНФОРМАЦИИ
'справочнике Договора
For i = 0 To q_vr
    
    For j = 0 To q_spr_dog
        If m_vr(i, 15) = m_spr_dog(j, 0) Then
            m_vr(i, 19) = m_spr_dog(j, 1) 'код проекта
            m_vr(i, 3) = m_spr_dog(j, 2) 'проект
            m_vr(i, 6) = m_spr_dog(j, 3) 'контрагент
            m_vr(i, 7) = m_spr_dog(j, 4) 'договор
            m_vr(i, 17) = m_spr_dog(j, 5) 'код статьи затрат
            If m_vr(i, 16) = "" Then m_vr(i, 16) = m_spr_dog(j, 6) 'код номенклатурной группы
            Exit For
        End If
    Next
 
Next
'заполняем Заказчика
For i = 0 To q_vr
    
    For j = 0 To q_spr_dog
        If m_vr(i, 19) = m_spr_dog(j, 1) Then 'фильтр по коду Проекта
            If m_spr_dog(j, 7) = "Контракты" Then
                m_vr(i, 2) = m_spr_dog(j, 8) 'заказчик
                Exit For
            End If
        End If
    Next
    
Next
 
'в справочнике Номенклатурные группы
For i = 0 To q_vr
    
    For j = 0 To q_spr_ng
        If m_vr(i, 16) = m_spr_ng(j, 0) Then
            m_vr(i, 4) = m_spr_ng(j, 1) 'номменклатурная группа
            m_vr(i, 11) = m_spr_ng(j, 2) 'направление
            If m_vr(i, 17) = "" Then
                m_vr(i, 17) = m_spr_ng(j, 5) 'код статьи затрат для проектов с не уникальной номм.группой
            End If
            Exit For
        End If
    Next
 
Next
 
'в справочнике Справочник статьи затрат
For i = 0 To q_vr
    
    For j = 0 To q_spr_sz
        If m_vr(i, 17) = m_spr_sz(j, 0) Then
            
            If m_spr_sz(j, 7) = "" Then 'условие для ?????!!!!!
                m_vr(i, 8) = m_spr_sz(j, 3) 'категория
                m_vr(i, 9) = m_spr_sz(j, 2) 'группа статей
                m_vr(i, 10) = m_spr_sz(j, 1) 'статья
                Exit For
            End If
            
        End If
    Next
 
Next
 
'ЗАПИСЬ В БАЗУ ДАННЫХ
wb_ab.Activate
 
Sheets(7).Range(Sheets(7).Cells(2, 1), Sheets(7).Cells(q_ft + 1, q_x)) = m_ft 'ФАКТ
Sheets(6).Range(Sheets(6).Cells(2, 1), Sheets(6).Cells(q_kr + 1, q_x)) = m_kr 'КОРРЕКТИРОВКИ
Sheets(8).Range(Sheets(8).Cells(2, 1), Sheets(8).Cells(q_vr + 1, q_x)) = m_vr 'ВЗАИМОРАСЧЕТЫ
Sheets(3).Range(Sheets(3).Cells(2, 1), Sheets(3).Cells(q_nr + 1, q_x)) = m_nr 'НАКЛАДНЫЕ РАСХОДЫ
 
End Sub

@~~Апострофф~~ Заблокирован
	12.08.2015, 16:49	2
	timofeevd, при копировании кода переключитесь на рус. раскладку и повторите вброс, пожалуйста... 0

@Hugo121 6922 / 2832 / 543 Регистрация: 19.10.2012 Сообщений: 8,645
	12.08.2015, 22:57	3
	Т.е. предлагаете по коду восстановить задачу и файл, и может быть придумать кучу процедур? А вообще можно сразу сказать что нужно сделать чтоб ускорить - не перебирать отдельные ячейки листа, перейти на массивы, вместо кучи and использовать вложенные if-then. 1

@timofeevd 0 / 0 / 0 Регистрация: 28.07.2013 Сообщений: 83
	13.08.2015, 08:24 [ТС]	4
	Сообщение от Hugo121 Т.е. предлагаете по коду восстановить задачу и файл, и может быть придумать кучу процедур? Нет. Меня как раз интересовали совета из разряда, что Вы в частности привели: Сообщение от Hugo121 вместо кучи and использовать вложенные if-then Сообщение от Hugo121 не перебирать отдельные ячейки листа - Это не занимает большое количество времени, т.к.объем строк для анализа небольшой примерно 45 000, Большое количество времени занимает непосредственно вывод строк в итоговые таблицы Excel. Сама задача следующая: 1. Из файлов источников забирает информацию по фильтру; храним в массиве 2. Открываем файлы-справочники и простым перебором заполняем недостающую информацию. В массив справочники не стал загонять, т.к.это при моих объемах на скорость сильно не влияет 3. Дополненную информацию вставляем в файл База данных для рисования отчетов, сводных таблиц и т.п. 4. Первый код указан только с точки зрения, чтобы показать что отключается/включается обновлению Excel 0

@Hugo121 6922 / 2832 / 543 Регистрация: 19.10.2012 Сообщений: 8,645
	13.08.2015, 08:55	5
	Сообщение от timofeevd - Это не занимает большое количество времени, т.к.объем строк для анализа небольшой примерно 45 000, Да ладно не занимает... Смотрите - вот тут If Cells(i, 1) >= d_n And Cells(i, 1) <= d_x Then возможно половина работы лишняя. И это чуть не в десяти местах (сбился со счёта...). а тут If Cells(i, 1) > d_x And Cells(i, 1) <= d_k And Cells(i, 10) = "ДиР" And Cells(i, 13) <> "Компенсации" Then лишних проверок 3/4. Причём это всё обращение к ячейкам. Добавлено через 11 минут По фильтру думаю можно сделать так: берём все исходные в массив, цикл по массиву - отобранное перекладываем в другой массив как у Вас, но в двумерный, чтоб выгружать быстро без цикла, а если памяти не хватает, то можно перекладыввать прямо в этом же вверх. Думаю всё ускорится раз так в 30, а возможно если видеть задачу живьём то и в 100 раз можно ускорить (если например привлечь словари/коллекции). И ещё не видно что там в этих секретных perenos/poisk... 0

@timofeevd 0 / 0 / 0 Регистрация: 28.07.2013 Сообщений: 83
	13.08.2015, 12:20 [ТС]	9
	Сообщение от Hugo121 i = 2 For i = 1 зачем и=2? К...А...С...Я...К...! Все остальное сейчас попробую. Добавлено через 1 час 4 минуты Сообщение от SoftIce Sheets(3).Range(Cells(2, 1), Cells(q_nr + 1, q_x)) = m_nr Выдает ошибку. Run-time error '1004': Application-defined or object-defined error 0

@Hugo121 6922 / 2832 / 543 Регистрация: 19.10.2012 Сообщений: 8,645
	13.08.2015, 12:25	10
	Не указано чьи cells - если активный не Sheets(3), то будет ошибка. 2

@timofeevd 0 / 0 / 0 Регистрация: 28.07.2013 Сообщений: 83
	13.08.2015, 12:31 [ТС]	11
	Еще вопрос При обращении к книгам, там где есть связи с другими книгами, идет запрос на обновление и потом на сохранение. Как мне кодом игнорировать данные запросы? 0

	17.08.2015, 16:20