Здравствуйте! Подскажите пожалуйста как мне ускорить работу следующего кода Есть два файла СД_Договоры и Журнал синхронизации, из файла СД_Договоры копируются ячейки с датой изменения больше последней даты синхронизации Это делается в цикле Но строк в документе примерно 1500, и он уж че то медленно отрабатывает. Подскажите как здесь можно использовать массив, чтобы он не каждую строку копировал-вставлял, а скопировал строки в массив, а из него в файл Журнал синхронизации вставил Ведь это же намного ускорит отработку.
[vba]
Код
Dim otdel, dateS As String Dim WS, WS1 As Worksheet Dim lRow, fRow, i As Integer
Set WS = ActiveWorkbook.Worksheets("Договоры") Set WS1 = ActiveWorkbook.Worksheets("Реквизиты") otdel = ActiveWorkbook.Worksheets("Реквизиты").Range("C9").Value dateS = WS1.Range("E4:E1000000").SpecialCells(xlCellTypeBlanks)(0) 'Находим последнюю дату синхронизации СД_Договоры
Call OpenedBook("СД_Договоры") ' открываем файл СД_договоры Workbooks.Item("СД_Договоры.xlsm").Sheets(1).Activate ' Активируем лист1 в СД_договоры ' В этом месте берется каждая ячейка из СД_Договоры и копируется в файл Журнал синхронизации With ActiveSheet lRow = .Cells(.Rows.Count, 4).End(xlUp).Row For i = 2 To lRow If (.Cells(i, "AF") > CDate(dateS)) Then WS.Cells(fRow, "B") = otdel .Cells(i, "A").Resize(1, 33).Copy: WS.Cells(fRow, "C").PasteSpecial xlPasteValues .Cells(i, "AF").Copy: WS.Cells(fRow, "A").PasteSpecial xlPasteValues
fRow = fRow + 1 End If Next i End With
[/vba]
Здравствуйте! Подскажите пожалуйста как мне ускорить работу следующего кода Есть два файла СД_Договоры и Журнал синхронизации, из файла СД_Договоры копируются ячейки с датой изменения больше последней даты синхронизации Это делается в цикле Но строк в документе примерно 1500, и он уж че то медленно отрабатывает. Подскажите как здесь можно использовать массив, чтобы он не каждую строку копировал-вставлял, а скопировал строки в массив, а из него в файл Журнал синхронизации вставил Ведь это же намного ускорит отработку.
[vba]
Код
Dim otdel, dateS As String Dim WS, WS1 As Worksheet Dim lRow, fRow, i As Integer
Set WS = ActiveWorkbook.Worksheets("Договоры") Set WS1 = ActiveWorkbook.Worksheets("Реквизиты") otdel = ActiveWorkbook.Worksheets("Реквизиты").Range("C9").Value dateS = WS1.Range("E4:E1000000").SpecialCells(xlCellTypeBlanks)(0) 'Находим последнюю дату синхронизации СД_Договоры
Call OpenedBook("СД_Договоры") ' открываем файл СД_договоры Workbooks.Item("СД_Договоры.xlsm").Sheets(1).Activate ' Активируем лист1 в СД_договоры ' В этом месте берется каждая ячейка из СД_Договоры и копируется в файл Журнал синхронизации With ActiveSheet lRow = .Cells(.Rows.Count, 4).End(xlUp).Row For i = 2 To lRow If (.Cells(i, "AF") > CDate(dateS)) Then WS.Cells(fRow, "B") = otdel .Cells(i, "A").Resize(1, 33).Copy: WS.Cells(fRow, "C").PasteSpecial xlPasteValues .Cells(i, "AF").Copy: WS.Cells(fRow, "A").PasteSpecial xlPasteValues