Есть файл книга2
, в него попадают данные с книга3
по прописанному макросу
К сожалению, возможно, из-за больших объемов и надстроек макросов в файле, работа макроса может занять 10-20 минут. Различные решения оптимизации пробовал добавить, но пока безуспешно.
Количество и объем данных примерно занимает где-то 6 колонок на 200 и более строк, но почему-то процесс идет слишком долго. Полагаю, одна из возможных проблем - это то, что я пытаюсь добавить этот макрос в процесс при изменении в диапозоне A:A
в книга2
.
Function ifopen(w As String) As Boolean
On Error Resume Next
ifopen = Workbooks(w).Name <> ""
End Function
Public Sub hyfre1()
Application.ErrorCheckingOptions.BackgroundChecking = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.StatusBar = False
If ifopen("книга3") = False Then
Workbooks.Open "C:\Users\nshuvalov\Desktop\книга3.xlsm", ReadOnly:=True
End If
Dim LastRow As Long
Dim LastRow2 As Long
LastRow = Workbooks("книга2").Sheets("план").Cells(Rows.Count, 1).End(xlUp).Row
LastRow2 = Workbooks("книга3").Sheets("выручка").Cells(Rows.Count, 1).End(xlUp).Row
With Workbooks("книга2").Sheets("план")
For s = 2 To LastRow
For xx = 2 To LastRow2
If Workbooks("книга2").Sheets("план").Cells(s, 1) = Workbooks("книга3").Sheets("выручка").Cells(xx, 1) Then
Workbooks("книга3").Sheets("выручка").Cells(xx, 6).Copy
Workbooks("книга2").Sheets("план").Cells(s, 2).PasteSpecial xlPasteValues
Workbooks("книга3").Sheets("выручка").Cells(xx, 3).Copy
Workbooks("книга2").Sheets("план").Cells(s, 3).PasteSpecial xlPasteValues
Workbooks("книга3").Sheets("выручка").Cells(xx, 2).Copy
Workbooks("книга2").Sheets("план").Cells(s, 4).PasteSpecial xlPasteValues
Workbooks("книга3").Sheets("выручка").Cells(xx, 5).Copy
Workbooks("книга2").Sheets("план").Cells(s, 5).PasteSpecial xlPasteValues
End If
Next
Next
End With
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.StatusBar = True
Application.ErrorCheckingOptions.BackgroundChecking = True
End Sub