Excel vba를 사용하여 특정 기준을 충족하는 섹션의 한 항목을 기반으로 데이터 섹션 삭제

이 문제를 공격한다면 A와 C를 비교하지 않고 동일한 프로세스에서 그룹 루핑 검사를 수행하지 않을 것이라고 생각합니다. 먼저 그룹에 대한 값 맵을 만드는 경우 문제를 해결하는 것이 더 쉬울 수 있습니다. 그룹 1, 3 및 5에 10의 값이 있다고 가정하면 10을 확인하고 향후 확인에서 즉시 3 개의 그룹을 제거 할 수 있습니다. 의 A Collection는 Collections조회 key가 매우 빠르며 저장되는 항목 수에 대해 걱정할 필요가 없으므로 이것에 대해 잘 도움이 될 것 입니다.

또한 Ranges각 그룹 에 대한 컬렉션이있는 경우 일치하는 그룹을 제거한 다음 한 번에 나머지를 모두 삭제하는 간단한 프로세스가 Ranges됩니다.

아래 코드는이를 수행해야합니다 (하지만 행 삭제 코드와 마찬가지로 먼저 원시 데이터를 백업하는 것이 좋습니다!).

Public Sub DeleteAdjacent()
    Dim ws As Worksheet
    Dim valueGroupMap As Collection
    Dim groupRanges As Collection
    Dim values As Collection
    Dim lastRow As Long
    Dim groupRng As Range
    Dim valueCell As Range
    Dim groupCell As Range
    Dim rng As Range
    Dim v As Variant
    Dim r As Long

    'Read the Column A worksheet
    Set ws = Workbooks("Workbook1.xlsx").Worksheets("Sheet A")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1 '+1 to get a blank row at end

    'Define the value map group ranges
    Set valueGroupMap = New Collection
    Set groupRanges = New Collection
    Set groupRng = ws.Cells(1, "N")

    For r = 1 To lastRow

        Set valueCell = ws.Cells(r, "A")
        Set groupCell = ws.Cells(r, "N")

        If Len(CStr(groupCell.Value2)) = 0 Then
            'We've reached the end of a group
            Set rng = ws.Range(groupRng, groupCell.Offset(-1))
            groupRanges.Add rng, CStr(groupRng.Value2)
            Set groupRng = Nothing
        Else
            'We're working within a group
            If groupRng Is Nothing Then
                Set groupRng = groupCell
            End If
            'Create the value to group map
            Set values = Nothing
            On Error Resume Next
            Set values = valueGroupMap(CStr(valueCell.Value2))
            On Error GoTo 0
            If values Is Nothing Then
                Set values = New Collection
                valueGroupMap.Add values, CStr(valueCell.Value2)
            End If
            values.Add CStr(groupRng.Value2)

        End If

    Next


    'Read the Column C worksheet
    Set ws = Workbooks("Workbook2.xlsx").Worksheets("Sheet B")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    On Error Resume Next
    For r = 1 To lastRow
        'Check if we have the value
        Set values = Nothing
        Set values = valueGroupMap(CStr(ws.Cells(r, "C").Value2))
        If Not values Is Nothing Then
            'We do, so remove the group ranges from our list
            For Each v In values
                groupRanges.Remove CStr(v)
            Next
        End If
    Next
    On Error GoTo 0

    'Create a range of the groups still remaining in the list
    Set rng = Nothing
    For Each groupRng In groupRanges
        If rng Is Nothing Then
            Set rng = groupRng
        Else
            Set rng = Union(rng, groupRng)
        End If
    Next

    'Delete that range
    rng.EntireRow.Delete

End Sub