Question

我有很多来自不同模块，具有不同列布局（采购订单，销售订单，生产订单等）的Excel。

我要删除包含“已开具发票”值的每一行。

我能够创建仅检查一列（“ 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

遍历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

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

这是另一种有趣的方式。假设您的数据从单元格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

如何删除整个工作表中包含“已开具发票”值的行

4 个答案: