복사 붙여 넣기 매크로가 매우 느림 | 최적화가 필요합니다.

Question

다음은 VBA 코드가 매우 느립니다 (세 개의 새 행을 복사하여 붙여 넣는 데 약 3 분이 소요됩니다!). 데이터베이스 자체에는 약 10,000 개의 행이 포함되어 있으며 성능 저하를 일으키는 지 또는 코드 자체가 효율적이지 않은지 여부는 확실하지 않습니다. 하드웨어 장비와는 아무런 관련이 없습니다.

Sub AutomateUserResearch() 

Dim rowlast As Long 'letzte benutze Zeile 
Dim rowlastexport As Long 'letzte benutze Zeile auf "database" + 1 addieren 
Dim rowlastexportfinal As Long 'letzte benutze Zeile auf "database" nach Hinzufügen neuer Zeilen finden 
Dim NewRecords As String 
Dim i As Integer 

Application.ScreenUpdating = False 

Calculate 
NewRecords = ThisWorkbook.Worksheets("checklist").Range("NewRecordsCheck").Value 

With Sheets("csv_import") 
    rowlast = .UsedRange.Rows.Count + .UsedRange.Row - 1 'find last used row on "csv_import" 

    .Range(.Cells(2, 1), .Cells(rowlast, 1)).Formula = .Cells(2, 1).Formula 'copy down formulas for column A 
' .Range(.Cells(2, 1), .Cells(rowlast, 1)).Select 
'  With Selection 
'   .Interior.ThemeColor = xlThemeColorAccent4 
'  End With 
    .Range(.Cells(2, 2), .Cells(rowlast, 2)).Formula = .Cells(2, 2).Formula 'copy down formulas for column B 
End With 

Sheets("csv_import").Calculate 

With Sheets("csv_import") 
    rowlast = .UsedRange.Rows.Count + .UsedRange.Row - 1 
End With 

With Sheets("database") 
    rowlastexport = .UsedRange.Rows.Count + 1 + .UsedRange.Row - 1 
End With 

ActiveWorkbook.Worksheets("csv_import").Activate 

If NewRecords = "YES" Then 'only proceed with Sub if Column A on "csv_import" has rows with "new" in it, otherwise Exit Sub as no new records exist 
    'MsgBox ("New Records Exist") 
    ActiveSheet.Range("A1:S1").AutoFilter Field:=1, Criteria1:="new" 
    ActiveSheet.Range("B2 : D" & rowlast).Copy 
    Sheets("database").Range("A" & rowlastexport).PasteSpecial 
    Sheets("csv_import").Range("A1:S1").AutoFilter Field:=1 
    Sheets("csv_import").Calculate 
    Sheets("checklist").Calculate 
Else: 
    MsgBox ("There are no new records to be exported!") 
    Exit Sub 
End If 

With ActiveWorkbook.Worksheets("database") 
    rowlastexportfinal = .UsedRange.Rows.Count + 1 + .UsedRange.Row - 1 
    For i = 4 To 19 'iterate through column 4 to 19 to copy down formulas and add color 
     .Range(.Cells(2, i), .Cells(rowlastexportfinal, i)).Formula = .Cells(2, i).Formula 
     .Range(.Cells(2, i), .Cells(rowlastexportfinal, i)).Interior.ColorIndex = 15 
    Next i 
End With 

Sheets("database").Calculate 
Sheets("database").Select 
Application.ScreenUpdating = True 

End Sub 

Answer 1

눈에 띄는 것이 아무것도 없습니다. 몇 가지 생각 :

Application.Calculation = xlCalculationManual을 설정해보십시오. 이렇게하면 셀 값이 변경 될 때마다 Excel이 계산되지 않습니다. 수식이 많으면 계산이 실제 성능 저하로 이어질 수 있습니다.

이렇게하는 이유가있을 수 있지만 코드 끝까지 계산을 강제 실행하고 전체 통합 문서를 한 번에 계산할 수도 있습니다.

클립 보드에 무언가를 복사 할 때마다 성능이 저하됩니다. 값 복사에만 관심이 있다면 Range("A1").Value = Range("B1").Value 값 복사 방법을 시도 할 수 있습니다. 이렇게하면 클립 보드를 우회하여 성능을 절약 할 수 있습니다.

워크 시트 이벤트가있는 경우 Application.EnableEvents = False을 설정해보십시오.

내가 생각할 수있는 유일한 것들입니다. 행운을 빕니다!