Excel VBA 성능 - 100만 행 - 값이 포함된 행을 1분 이내에 삭제

Excel VBA 성능 - 100만 행 - 값이 포함된 행을 1분 이내에 삭제

대용량 데이터를 필터링하고 워크시트에서 행을 1분 이내에 제거하는 방법을 찾고 있습니다.

목표:

• 1열에서 특정 텍스트가 포함된 모든 레코드를 찾고 전체 행을 삭제
• 모든 셀 형식(색상, 글꼴, 테두리, 열 너비) 및 수식을 그대로 유지합니다.

.

테스트 데이터:

:

.

코드 작동 방식:

1. 모든 Excel 기능을 해제하는 것으로 시작합니다.

2. 워크북이 비어 있지 않고 제거할 텍스트 값이 1열에 있는 경우

   • 1열의 사용된 범위를 배열로 복사합니다.
   • 어레이의 모든 값을 거꾸로 반복합니다.

   • 일치하는 항목을 찾을 때:

     • 에 셀 를 tmp 합니다."A11,A275,A3900,..."
     • tmp 변수 길이가 255자에 가까운 경우
     • 다음을 사용하여 행을 삭제합니다..Range("A11,A275,A3900,...").EntireRow.Delete Shift:=xlUp
     • tmp를 빈 상태로 재설정하고 다음 행 집합으로 이동합니다.
3. 마지막에는 모든 Excel 기능이 다시 켜집니다.

.

주요 문제는 삭제 작업이며, 총 지속 시간은 1분 미만이어야 합니다.코드 기반 솔루션은 1분 미만의 성능을 발휘하는 한 허용됩니다.

이를 통해 허용 가능한 답변의 범위가 매우 적은 수의 답변으로 범위를 좁힙니다.이미 제공된 답변도 매우 짧고 구현하기 쉽습니다.한 명은 약 30초 만에 작업을 수행하므로, 허용 가능한 솔루션을 제공하는 답변이 하나 이상 있으며, 다른 한 명은 이 작업이 유용하다고 생각할 수도 있습니다.

.

나의 주요 초기 기능:

Sub DeleteRowsWithValuesStrings()
    Const MAX_SZ As Byte = 240

    Dim i As Long, j As Long, t As Double, ws As Worksheet
    Dim memArr As Variant, max As Long, tmp As String

    Set ws = Worksheets(1)
    max = GetMaxCell(ws.UsedRange).Row
    FastWB True:    t = Timer

    With ws
        If max > 1 Then
            If IndexOfValInRowOrCol("Test String", , ws.UsedRange) > 0 Then
                memArr = .Range(.Cells(1, 1), .Cells(max, 1)).Value2
                For i = max To 1 Step -1

                    If memArr(i, 1) = "Test String" Then
                        tmp = tmp & "A" & i & ","
                        If Len(tmp) > MAX_SZ Then
                           .Range(Left(tmp, Len(tmp) - 1)).EntireRow.Delete Shift:=xlUp
                           tmp = vbNullString

                        End If
                    End If

                Next
                If Len(tmp) > 0 Then
                    .Range(Left(tmp, Len(tmp) - 1)).EntireRow.Delete Shift:=xlUp
                End If
                .Calculate
            End If
        End If
    End With
    FastWB False:   InputBox "Duration: ", "Duration", Timer - t
End Sub

---

도우미 기능(Excel 기능을 껐다가 켭니다.)

Public Sub FastWB(Optional ByVal opt As Boolean = True)
    With Application
        .Calculation = IIf(opt, xlCalculationManual, xlCalculationAutomatic)
        .DisplayAlerts = Not opt
        .DisplayStatusBar = Not opt
        .EnableAnimations = Not opt
        .EnableEvents = Not opt
        .ScreenUpdating = Not opt
    End With
    FastWS , opt
End Sub

Public Sub FastWS(Optional ByVal ws As Worksheet = Nothing, _
                  Optional ByVal opt As Boolean = True)
    If ws Is Nothing Then
        For Each ws In Application.ActiveWorkbook.Sheets
            EnableWS ws, opt
        Next
    Else
        EnableWS ws, opt
    End If
End Sub

Private Sub EnableWS(ByVal ws As Worksheet, ByVal opt As Boolean)
    With ws
        .DisplayPageBreaks = False
        .EnableCalculation = Not opt
        .EnableFormatConditionsCalculation = Not opt
        .EnablePivotTable = Not opt
    End With
End Sub

---

데이터가 있는 마지막 셀을 찾습니다(고마워 @ZygD - 이제 여러 시나리오에서 테스트했습니다).

Public Function GetMaxCell(Optional ByRef rng As Range = Nothing) As Range

    'Returns the last cell containing a value, or A1 if Worksheet is empty

    Const NONEMPTY As String = "*"
    Dim lRow As Range, lCol As Range

    If rng Is Nothing Then Set rng = Application.ActiveWorkbook.ActiveSheet.UsedRange
    If WorksheetFunction.CountA(rng) = 0 Then
        Set GetMaxCell = rng.Parent.Cells(1, 1)
    Else
        With rng
            Set lRow = .Cells.Find(What:=NONEMPTY, LookIn:=xlFormulas, _
                                        After:=.Cells(1, 1), _
                                        SearchDirection:=xlPrevious, _
                                        SearchOrder:=xlByRows)
            If Not lRow Is Nothing Then
                Set lCol = .Cells.Find(What:=NONEMPTY, LookIn:=xlFormulas, _
                                            After:=.Cells(1, 1), _
                                            SearchDirection:=xlPrevious, _
                                            SearchOrder:=xlByColumns)

                Set GetMaxCell = .Parent.Cells(lRow.Row, lCol.Column)
            End If
        End With
    End If
End Function

---

배열에서 일치하는 인덱스를 반환하거나 일치하는 항목이 없으면 0을 반환합니다.

Public Function IndexOfValInRowOrCol( _
                                    ByVal searchVal As String, _
                                    Optional ByRef ws As Worksheet = Nothing, _
                                    Optional ByRef rng As Range = Nothing, _
                                    Optional ByRef vertical As Boolean = True, _
                                    Optional ByRef rowOrColNum As Long = 1 _
                                    ) As Long

    'Returns position in Row or Column, or 0 if no matches found

    Dim usedRng As Range, result As Variant, searchRow As Long, searchCol As Long

    result = CVErr(9999) '- generate custom error

    Set usedRng = GetUsedRng(ws, rng)
    If Not usedRng Is Nothing Then
        If rowOrColNum < 1 Then rowOrColNum = 1
        With Application
            If vertical Then
                result = .Match(searchVal, rng.Columns(rowOrColNum), 0)
            Else
                result = .Match(searchVal, rng.Rows(rowOrColNum), 0)
            End If
        End With
    End If
    If IsError(result) Then IndexOfValInRowOrCol = 0 Else IndexOfValInRowOrCol = result
End Function

.

업데이트:

6개 솔루션 테스트(각각 3개 테스트):Excel Hero의 솔루션은 현재까지 가장 빠릅니다(공식 제거).

.

다음은 가장 빠른 속도에서 가장 느린 속도의 결과입니다.

.

시험 1. 총 100,000개의 기록, 삭제할 10,000개:

1. ExcelHero()                    - 1.5 seconds

2. DeleteRowsWithValuesNewSheet() - 2.4 seconds

3. DeleteRowsWithValuesStrings()  - 2.45 minutes
4. DeleteRowsWithValuesArray()    - 2.45 minutes
5. QuickAndEasy()                 - 3.25 minutes
6. DeleteRowsWithValuesUnion()    - Stopped after 5 minutes

.

시험 2. 총 100만 개의 기록, 삭제할 10만 개:

1. ExcelHero()                    - 16 seconds (average)

2. DeleteRowsWithValuesNewSheet() - 33 seconds (average)

3. DeleteRowsWithValuesStrings()  - 4 hrs 38 min (16701.375 sec)
4. DeleteRowsWithValuesArray()    - 4 hrs 37 min (16626.3051757813 sec)
5. QuickAndEasy()                 - 5 hrs 40 min (20434.2104492188 sec)
6. DeleteRowsWithValuesUnion()    - N/A

.

주의:

1. ExcelHero 메소드: 구현이 쉽고, 신뢰할 수 있으며, 매우 빠르지만 공식은 제거합니다.
2. 새로운 Sheet 방법: 구현이 쉽고 신뢰할 수 있으며 목표를 충족합니다.
3. Strings method: 구현에 더 많은 노력을 기울이고, 신뢰할 수 있지만 요구 사항을 충족하지 않음
4. 배열 방법: Strings와 유사하지만 ReDims 배열(Union의 빠른 버전)
5. QuickAndEasy: 구현이 간단하지만(짧고, 신뢰할 수 있으며, 우아함) 요구사항을 충족하지 못합니다.
6. Range Union: 2 및 3과 유사한 구현 복잡성, 그러나 너무 느림

또한 비정상적인 값을 도입하여 테스트 데이터를 보다 현실적으로 만들었습니다.

• 빈 셀, 범위, 행 및 열
• 특수 문자(예: =['!@#$%^&*()_-+{}[]\|;:', , .<>/?, 분리 및 다중 조합
• 공백, 탭, 빈 수식, 테두리, 글꼴 및 기타 셀 형식
• 소수점 이하의 큰 숫자 및 작은 숫자(=12.999999999999 + 0.00000000001)
• 하이퍼링크, 조건부 형식 지정 규칙
• 비어 있는 형식 데이터 범위 내부 및 외부
• 데이터 문제를 야기할 수 있는 기타 사항

첫 번째 답변을 참고 자료로 제공합니다.

다른 옵션이 없을 경우 유용할 수 있습니다.

• 결과를 얻는 가장 빠른 방법은 삭제 작업을 사용하지 않는 것입니다.
• 100만 개의 레코드 중에서 평균 33초 만에 100,000개의 행을 제거합니다.

.

Sub DeleteRowsWithValuesNewSheet()  '100K records   10K to delete
                                    'Test 1:        2.40234375 sec
                                    'Test 2:        2.41796875 sec
                                    'Test 3:        2.40234375 sec
                                    '1M records     100K to delete
                                    'Test 1:        32.9140625 sec
                                    'Test 2:        33.1484375 sec
                                    'Test 3:        32.90625   sec
    Dim oldWs As Worksheet, newWs As Worksheet, rowHeights() As Long
    Dim wsName As String, t As Double, oldUsedRng As Range

    FastWB True:    t = Timer

    Set oldWs = Worksheets(1)
    wsName = oldWs.Name

    Set oldUsedRng = oldWs.Range("A1", GetMaxCell(oldWs.UsedRange))

    If oldUsedRng.Rows.Count > 1 Then                           'If sheet is not empty
        Set newWs = Sheets.Add(After:=oldWs)                    'Add new sheet
        With oldUsedRng
            .AutoFilter Field:=1, Criteria1:="<>Test String"
            .Copy                                               'Copy visible data
        End With
        With newWs.Cells
            .PasteSpecial xlPasteColumnWidths
            .PasteSpecial xlPasteAll                            'Paste data on new sheet
            .Cells(1, 1).Select                                 'Deselect paste area
            .Cells(1, 1).Copy                                   'Clear Clipboard
        End With
        oldWs.Delete                                            'Delete old sheet
        newWs.Name = wsName
    End If
    FastWB False:   InputBox "Duration: ", "Duration", Timer - t
End Sub

.

높은 수준에서:

• 새 워크시트를 생성하고 초기 시트에 대한 참조를 유지합니다.
• 열 1: 검된열텍의 1동자필터:.AutoFilter Field:=1, Criteria1:="<>Test String"
• 초기 시트에서 모든(보이는) 데이터 복사
• 열 너비, 형식 및 데이터를 새 시트에 붙여넣습니다
• 초기 시트를 삭제합니다.
• 새 시트의 이름을 이전 시트 이름으로 바꿉니다.

질문에 게시된 것과 동일한 도우미 기능을 사용합니다.

지속 시간의 99%는 AutoFilter에 의해 사용됩니다.

.

제가 지금까지 발견한 몇 가지 제한 사항이 있는데, 첫 번째는 다음과 같습니다.

1. 초기 시트에 숨겨진 행이 있으면 해당 행을 숨깁니다.

   • 이를 다시 숨기려면 별도의 기능이 필요합니다.
   • 구현에 따라 기간이 크게 늘어날 수 있습니다.

2. VBA 관련:

   • 시트의 코드 이름이 변경됩니다. 시트 1을 참조하는 다른 VBA가 손상됩니다(있는 경우).
   • 초기 시트와 연결된 모든 VBA 코드가 삭제됩니다(있는 경우).

.

다음과 같은 대용량 파일 사용에 대한 몇 가지 참고 사항:

• 이진 형식(.xlsb)은 파일 크기를 137Mb에서 43Mb로 크게 줄입니다.

• 관리되지 않는 조건부 서식 규칙으로 인해 성능 문제가 기하급수적으로 발생할 수 있음

  • 의견 및 데이터 유효성 검사도 동일합니다.

• 네트워크에서 파일 또는 데이터를 읽는 속도가 로컬 파일로 작업하는 속도보다 훨씬 느림

원본 데이터에 공식이 포함되어 있지 않거나 시나리오에서 조건부 행 삭제 중에 공식을 하드 값으로 변환할 수 있거나 변환을 원할 경우 속도가 크게 향상될 수 있습니다.

위의 내용을 주의하여 내 솔루션은 범위 개체의 Advanced Filter를 사용합니다.DeleteRowsWithValuesNewSheet()보다 약 2배 빠릅니다.

Public Sub ExcelHero()
    Dim t#, crit As Range, data As Range, ws As Worksheet
    Dim r&, fc As Range, lc As Range, fr1 As Range, fr2 As Range
    FastWB True
    t = Timer

        Set fc = ActiveSheet.UsedRange.Item(1)
        Set lc = GetMaxCell
        Set data = ActiveSheet.Range(fc, lc)
        Set ws = Sheets.Add
        With data
            Set fr1 = data.Worksheet.Range(fc, fc.Offset(, lc.Column))
            Set fr2 = ws.Range(ws.Cells(fc.Row, fc.Column), ws.Cells(fc.Row, lc.Column))
            With fr2
                fr1.Copy
                .PasteSpecial xlPasteColumnWidths: .PasteSpecial xlPasteAll
                .Item(1).Select
            End With
            Set crit = .Resize(2, 1).Offset(, lc.Column + 1)
            crit = [{"Column 1";"<>Test String"}]
            .AdvancedFilter xlFilterCopy, crit, fr2
            .Worksheet.Delete
        End With

    FastWB False
    r = ws.UsedRange.Rows.Count
    Debug.Print "Rows: " & r & ", Duration: " & Timer - t & " seconds"
End Sub

이전 Dell Inspiron 1564(Win 7 Office 2007)의 경우:

Sub QuickAndEasy()
    Dim rng As Range
    Set rng = Range("AA2:AA1000001")
    Range("AB1") = Now
    Application.ScreenUpdating = False
        With rng
            .Formula = "=If(A2=""Test String"",0/0,A2)"
            .Cells.SpecialCells(xlCellTypeFormulas, xlErrors).EntireRow.Delete
            .Clear
        End With
    Application.ScreenUpdating = True
    Range("AC1") = Now
End Sub

실행하는 데 약 10초가 걸렸습니다.저는 AA란이 가능하다고 생각합니다.

EDIT#1:

이 코드는 계산을 수동으로 설정하지 않습니다.도우미 열 계산이 허용된 후 계산 모드를 수동으로 설정하면 성능이 향상됩니다.

제가 여기서 제 대답에 엄청나게 늦었다는 것을 알지만, 미래의 방문자들은 그것이 매우 유용하다고 생각할 것입니다.

참고:내 접근 방식에서는 행이 원래 순서대로 끝나려면 인덱스 열이 필요하지만, 행이 다른 순서로 되어 있어도 상관이 없다면 인덱스 열이 필요하지 않고 코드의 추가 행을 제거할 수 있습니다.

내 접근 방식: 내 접근 방식은 단순히 선택한 범위(열)의 모든 행을 선택하고 다음을 사용하여 오름차순으로 정렬하는 것이었습니다.Range.Sort그리고 나서 첫 번째와 마지막 색인을 수집합니다."Test String"선택한 범위(열) 내에 있습니다. 첫 인덱스에서 그런다첫번및마인지막덱범사만다용니합들고위를서에스음째▁from를 사용합니다.Range.EntrieRow.Delete합니다."Test String".

의견:
그것은 빠르게 타오르고 있습니다.
서식, 수식, 차트, 사진 등을 새 시트에 복사하는 방법을 제거하지 않습니다.

단점:
구현하기에 적당한 크기의 코드이지만 모두 간단합니다.

테스트 범위 생성 하위:

Sub DevelopTest()
    Dim index As Long
    FastWB True
    ActiveSheet.UsedRange.Clear
    For index = 1 To 1000000 '1 million test
        ActiveSheet.Cells(index, 1).Value = index
        If (index Mod 10) = 0 Then
            ActiveSheet.Cells(index, 2).Value = "Test String"
        Else
            ActiveSheet.Cells(index, 2).Value = "Blah Blah Blah"
        End If
    Next index
    Application.StatusBar = ""
    FastWB False
End Sub

행 필터링 및 삭제 하위:

Sub DeleteRowFast()
    Dim curWorksheet As Worksheet 'Current worksheet vairable

    Dim rangeSelection As Range   'Selected range
    Dim startBadVals As Long      'Start of the unwanted values
    Dim endBadVals As Long        'End of the unwanted values
    Dim strtTime As Double        'Timer variable
    Dim lastRow As Long           'Last Row variable
    Dim lastColumn As Long        'Last column variable
    Dim indexCell As Range        'Index range start
    Dim sortRange As Range        'The range which the sort is applied to
    Dim currRow As Range          'Current Row index for the for loop
    Dim cell As Range             'Current cell for use in the for loop

    On Error GoTo Err
        Set rangeSelection = Application.InputBox("Select the (N=) range to be checked", "Get Range", Type:=8)    'Get the desired range from the user
        Err.Clear

    M1 = MsgBox("This is recommended for large files (50,000 or more entries)", vbYesNo, "Enable Fast Workbook?") 'Prompt the user with an option to enable Fast Workbook, roughly 150% performace gains... Recommended for incredibly large files
    Select Case M1
        Case vbYes
            FastWB True  'Enable fast workbook
        Case vbNo
            FastWB False 'Disable fast workbook
    End Select

    strtTime = Timer     'Begin the timer

    Set curWorksheet = ActiveSheet
    lastRow = CLng(rangeSelection.SpecialCells(xlCellTypeLastCell).Row)
    lastColumn = curWorksheet.Cells(1, 16384).End(xlToLeft).Column

    Set indexCell = curWorksheet.Cells(1, 1)

    On Error Resume Next

    If rangeSelection.Rows.Count > 1 Then 'Check if there is anything to do

        lastVisRow = rangeSelection.Rows.Count

        Set sortRange = curWorksheet.Range(indexCell, curWorksheet.Cells(curWorksheet.Rows(lastRow).Row, 16384).End(xlToLeft)) 'Set the sort range

        sortRange.Sort Key1:=rangeSelection.Cells(1, 1), Order1:=xlAscending, Header:=xlNo 'Sort by values, lowest to highest

        startBadVals = rangeSelection.Find(What:="Test String", LookAt:=xlWhole, MatchCase:=False).Row
        endBadVals = rangeSelection.Find(What:="Test String", LookAt:=xlWhole, SearchDirection:=xlPrevious, MatchCase:=False).Row

        curWorksheet.Range(curWorksheet.Rows(startBadVals), curWorksheet.Rows(endBadVals)).EntireRow.Delete 'Delete uneeded rows, deleteing in continuous range blocks is quick than seperated or individual deletions.

        sortRange.Sort Key1:=indexCell, Order1:=xlAscending, Header:=xlNo 'Sort by index instead of values, lowest to highest
    End If

    Application.StatusBar = ""                    'Reset the status bar

    FastWB False                                  'Disable fast workbook

    MsgBox CStr(Round(Timer - strtTime, 2)) & "s" 'Display duration of task

Err:
    Exit Sub

End Sub

는 이코의용을 사용합니다.FastWB,FastWS그리고.EnableWS 폴 비카 아!

at entries(할 10K FastWB True):100K 항목제횟수(10k, FastWB 참):
0.2초.
0.2초.
0.21초.
평균 0.2초.

항목에서 , True100회(100k, FastWB 참):
2.3초.
2.32초.
2.3초.
평균 2.31초.

실행 중: 윈도우 10, iMac i3 11,2 (2010년부터)

편집
이 코드는 원래 숫자 범위 밖의 숫자 값을 필터링하기 위해 설계되었으며 필터링할 수 있도록 조정되었습니다."Test String"그래서 일부 코드는 중복될 수 있습니다.

사용된 범위와 행 수를 계산할 때 배열을 사용하면 성능에 영향을 줄 수 있습니다.여기 테스트에서 25-30초 사이에 1m 이상의 데이터 행에 걸쳐 효율적인 것으로 입증된 또 다른 접근 방식이 있습니다.필터를 사용하지 않으므로 숨겨도 행이 삭제됩니다.전체 행을 삭제해도 나머지 행의 형식이나 열 너비에는 영향을 주지 않습니다.

1. 먼저 ActiveSheet에 "테스트 문자열"이 있는지 확인합니다.열 1에만 관심이 있기 때문에 다음을 사용했습니다.

   TCount = Application.WorksheetFunction.CountIf(sht.Columns(1), "Test String")
   If TCount > 0 Then
   

2. GetMaxCell() 함수를 사용하는 대신 단순히 사용했습니다.Cells.SpecialCells(xlCellTypeLastCell).Row마지막 행 가져오기:

   EndRow = sht.Cells.SpecialCells(xlCellTypeLastCell).Row
   

3. 그런 다음 데이터 행을 반복합니다.

   While r <= EndRow
   

4. 1열의 셀이 "테스트 문자열"과 동일한지 테스트하는 방법

   If sht.Cells(r, 1).Text) = "Test String" Then
   

5. 행 삭제하기

   Rows(r).Delete Shift:=xlUp
   

아래의 전체 코드를 모두 합친 것입니다.저는 ActiveSheet을 변수 Sht로 설정하고 효율성을 높이기 위해 ScreenUpdating 턴을 추가했습니다.데이터가 많기 때문에 마지막에 변수를 확실히 제거합니다.

Sub RowDeleter()
    Dim sht As Worksheet
    Dim r As Long
    Dim EndRow As Long
    Dim TCount As Long
    Dim s As Date
    Dim e As Date

    Application.ScreenUpdating = True
    r = 2       'Initialise row number
    s = Now     'Start Time
    Set sht = ActiveSheet
    EndRow = sht.Cells.SpecialCells(xlCellTypeLastCell).Row

    'Check if "Test String" is found in Column 1
    TCount = Application.WorksheetFunction.CountIf(sht.Columns(1), "Test String")
    If TCount > 0 Then

        'loop through to the End row
        While r <= EndRow
            If InStr(sht.Cells(r, 1).Text, "Test String") > 0 Then
                sht.Rows(r).Delete Shift:=xlUp
                r = r - 1
            End If
            r = r + 1
        Wend
    End If
    e = Now  'End Time
    D = (Hour(e) * 360 + Minute(e) * 60 + Second(e)) - (Hour(s) * 360 + Minute(s) * 60 + Second(s))
    Application.ScreenUpdating = True
    DurationTime = TimeSerial(0, 0, D)
    MsgBox Format(DurationTime, "hh:mm:ss")
End Sub

언급URL : https://stackoverflow.com/questions/30959315/excel-vba-performance-1-million-rows-delete-rows-containing-a-value-in-less