Question

这是克里斯在这里！本周早些时候，我发布了一个关于代码的问题，如果不同列（同一行）中的三个单元符合某个文本值标准，则该代码将删除一行。在这种情况下，文本值为＆＃34; PURGE＆＃34;对于所有三个细胞，不区分大小写。

方法是搜索列（在本例中为D），找到满足搜索词的第一个值，然后偏移到下一个指定列，以验证是否存在满足以下值的条件。

我今天的问题是，如何指定我接受的标准之一是空白值？我想修改我的代码，例如，在第4列（D）中搜索＆＃34; PURGE＆＃34;如果第5列（E）是空白（没有），第6列（F）表示＆＃34; PURGE＆＃34;然后删除该行。

我将发布一个名叫汤姆的好伙伴帮助我的代码。

此外，我将复制并移动代码以满足搜索字词不同的条件。我可能还想编辑代码以接受多个空白单元格值作为删除条件。

让我知道是否有任何方法可以让我的问题更清楚，或者如果我已经找到了一个我需要的答案我无法找到的帖子！

非常感谢所有人，你在这里的时间比我在文字中写的更多！ -Chris

这就是我所拥有的：

Option Explicit

Sub DeleteRows()
Dim wbk As Workbook
Dim wsh As Worksheet
Dim strPath As String, strFile As String, strFind As String, firstAddress As 
String
Dim x As Range, y As Range, z As Range
Dim DelRng As Range


'searches directory for any and all excel files
With Application.FileDialog(msoFileDialogFolderPicker)
    If .Show Then
        strPath = .SelectedItems(1)
    Else
        MsgBox "No folder selected!", vbExclamation
        Exit Sub
    End If
End With

If Right(strPath, 1) <> "\" Then
    strPath = strPath & "\"
End If

With Application
    .ScreenUpdating = False
    ' Stops xlsm files on Open event
    .EnableEvents = False
    ' uncomment to hide any deletion message boxes
    ' .DisplayAlerts = False
End With

strFile = Dir(strPath & "*.xls*")

'end file finding and such

Do While Len(strFile) > 0

    Set wbk = Workbooks.Open(Filename:=strPath & strFile, AddToMRU:=False)

    For Each wsh In wbk.Worksheets

        'supposed to search column d, offset column +1 in same row,
        'then do same for a third row.
        'if all three cells contain "PURGE" then delete cell

        With wsh.Columns(4)
            Set x = .Find("PURGE", Lookat:=xlPart)
            If Not x Is Nothing Then
                firstAddress = x.Address
                Do
                    If InStr(1, x.Offset(0, 1), "purge", vbTextCompare) > 0 And InStr(1, x.Offset(0, 2), "purge", vbTextCompare) > 0 Then
                        If DelRng Is Nothing Then
                            Set DelRng = x
                        Else
                            Set DelRng = Union(DelRng, x)
                        End If
                    End If
                    Set x = .FindNext(x)
                Loop While Not x Is Nothing And x.Address <> firstAddress
            End If
        End With
    Next wsh
    If Not DelRng Is Nothing Then DelRng.EntireRow.Delete

    wbk.Close SaveChanges:=True
    strFile = Dir()
Loop

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

Answer 1

使用两个标准.AutoFilter和xlOr似乎是一种更有效的方法。

For Each wsh In wbk.Worksheets
    With wsh
        If .AutoFilterMode Then .AutoFilterMode = False
        With .Cells(1, "A").CurrentRegion
            .AutoFilter Field:=4, Criteria1:="*purge*", Operator:=xlOr, Criteria2:=""
            .AutoFilter Field:=5, Criteria1:="*purge*", Operator:=xlOr, Criteria2:=""
            .AutoFilter Field:=6, Criteria1:="*purge*", Operator:=xlOr, Criteria2:=""
            With .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0)
                If CBool(Application.Subtotal(103, .Cells)) Then
                    .Cells.EntireRow.Delete
                End If
            End With
        End With
        If .AutoFilterMode Then .AutoFilterMode = False
    End With
Next wsh

如果满足三个值，或者三个值中的一个为空，则Excel VBA删除行

1 个答案: