Excel VBA：在工作表的“偏移量”列中查找一个值以查找相同的值

Question

Apologies for my newbishness but I am experiencing a bit of an issue regarding some excel vba code I made. It is meant to clean an excel sheet that has hundreds of entries.

The format is always the same, and columns D, E, and F will sometimes have the same word in all three of them (the word purge). When this is the case, I want that row deleted.

I have tried to use define a my range as D, and using the .Find feature search for my item in question. Then from there offset Find offset Find.

Alas, my program has converted from telling me I am coding wrong to simply running (freezing) forever with no results. I will post my code so that maybe my situation is more clear.

PS If someone can help me fix my code, and also explain what I did wrong and why, it would be much appreciated!

Thank you, all!

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



    '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
    Application.ScreenUpdating = False
    strFile = Dir(strPath & "*.xls*")
    Do While strFile <> ""
    Set wbk = Workbooks.Open(Filename:=strPath & strFile, AddToMRU:=False)

    For Each wsh In wbk.Worksheets
    'end directory search


    '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

         Set SrchRng = ActiveSheet.Range("D1", 
    ActiveSheet.Range("D65536").End(xlUp))
        Do
            Set x = SrchRng.Find("PURGE", LookIn:=xlValues)
            Set y = ActiveCell.Offset(0, 1).Find("PURGE", LookIn:=xlValues)
            Set z = ActiveCell.Offset(0, 2).Find("PURGE", LookIn:=xlValues)

          If Not x Is Nothing And Not y Is Nothing And Not z Is Nothing Then         x.EntireRow.Delete
            Loop While Not x Is Nothing

            Next
            For Each wsh In wbk.Worksheets


            Next wsh

            wbk.Close SaveChanges:=True
            strFile = Dir



            Application.ScreenUpdating = True
    End Sub

Answer 1

I would personally write the formula in excel that would figure out if a row needs to be deleted or not. (do any of the columns for the row contain the word you are looking for). Once I know the formula work correctly I would add it to the file using vba in the last column.

Once the formula in the last column I would sort this row and deleted any of the rows I need. Then delete the new column and save the file.

Answer 2

Have a look at this. This uses FindNext and Offset (not entirely sure why you were trying to use Find on one cell) This finds the value PURGE and if the two cells next to it are also PURGE it then deletes the row. If not it carries on going.

Also this line Do While strFile <> "" needs a Loop at some point although not sure where you wanted it.

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*")

    Do While Len(strFile) > 0

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

        For Each wsh In wbk.Worksheets
            'end directory search
            '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