Как удалить строки, которые содержат значение «Выставлено» во всей рабочей таблице

Question

У меня много Excels из разных модулей с разным расположением столбцов (заказы на покупку, заказы на продажу, производственные заказы и т.1003 *

Мне удалось создать простой код, в котором проверен только один столбец ("J"), но мне нужно проверить весь лист.

Private Sub BoomShakalaka_Click()

    Application.ScreenUpdating = False
    ow = Cells(Rows.Count, "J").End(xlUp).Row
    For r = ow To 1 Step -1
        If Cells(r, "J") = "Invoiced" Then Rows(r).Delete

    Next
    Application.ScreenUpdating = True

End Sub

Я ожидаю, что после запуска этой функции, он проверит всю книгу и удалит каждую строку, содержащую значение «Выставлено».

Answer 1

Я хочу добавить сюда свою идею использовать вместо этого массивы, чтобы вы получали доступ к рабочему листу только при чтении данных, а затем при удалении строк.

Option Explicit

Sub deleteInvoiced()

With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With

Dim wb As Workbook: Set wb = ActiveWorkbook         'or ThisWorkbook, or the name of the workbook where data is
Dim ws As Worksheet
Dim R As Long, C As Long, X As Long
Dim lRow As Long, lCol As Long

Dim arrData

    For Each ws In wb.Worksheets
        lRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).row                     'Get the last row in the current sheet
        lCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column           'Get the last column in the current sheet

        arrData = ws.Range(ws.Cells(1, 1), ws.Cells(lRow, lCol))

        For R = UBound(arrData) To LBound(arrData) Step -1
            For C = UBound(arrData, 2) To LBound(arrData, 2) Step -1
                If arrData(R, C) = "Invoiced" Or arrData(R, C) = "Delivered" Then
                    'Now delete the rows
                    ws.Cells(R, C).EntireRow.Delete
                    Exit For 'Exit here in case multiple "Invoice" or "Delivered" in the same row (WHY?!!). Thanks @Brian.
                End If
            Next C
        Next R
    Next ws

With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
End With

End Sub

PS: нет обработки ошибок, но я оставляю это вам.

Answer 2

Вот еще один интересный способ. Предполагается, что ваши данные начинаются в ячейке A1 и являются непрерывными.

Option Explicit

Public Sub TestDeleteInvoiced()

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim arr As Variant
    Dim arr1() As Variant
    Dim row As Long
    Dim col As Long
    Dim i As Long

    Set wb = ActiveWorkbook
    i = 1
    ReDim arr1(1 To 14)

    For Each ws In wb.Worksheets
        arr = ws.Range("A1").CurrentRegion

        For row = UBound(arr, 1) To LBound(arr, 1) Step -1
            For col = UBound(arr, 2) To LBound(arr, 2) Step -1
                If arr(row, col) = "Invoiced" Then
                    arr1(i) = row & ":" & row
                    i = i + 1
                        'This If statement ensures that the Join function is less than 255 characters.
                        If i = 15 Then
                            ws.Range(Join(arr1, ", ")).EntireRow.Delete
                            ReDim arr1(1 To 14)
                            i = 1
                        End If
                    Exit For
                End If
            Next col
        Next row

        ReDim Preserve arr1(1 To i - 1)
        ws.Range(Join(arr1, ", ")).EntireRow.Delete
    Next ws

End Sub

Примечание. Удаление диапазона несмежных строк не может превышать 255 символов. Link

Answer 3

Кроме того, вы можете сделать это, используя find.Это будет быстрее, чем мой другой ответ, если данных много:

sub BoomShakalaka_Click()
    screenupdating = false
    On Error GoTo exitSub

    ActiveSheet.UsedRange.SpecialCells(xlLastCell).select

    do while true
        Cells.Find(What:="Invoiced", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False _
        , SearchFormat:=False).Activate
        Selection.EntireRow.Delete

    Loop

exitSub:
    screenupdating = True
    Exit Sub
end sub

Answer 4

Цикл каждой ячейки внутри каждой строки в activesheet.usedrange:

Private Sub BoomShakalaka_Click()
    For r = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
        For Each c In ActiveSheet.UsedRange.Rows(r).Cells
            If c.Value = "Invoiced" Then
                c.EntireRow.Delete
                Exit For
            End If
        Next c
    Next r

End Sub