Question

为我的新生事道歉，但我遇到了一些关于我制作的excel vba代码的问题。它旨在清理包含数百个条目的Excel工作表。

格式始终相同，列D，E和F有时在所有三个中都有相同的单词（单词purge）。在这种情况下，我希望删除该行。

我试图将我的范围定义为D，并使用.Find功能搜索我的问题。然后从那里偏移查找偏移量查找。

唉，我的程序已经转变为告诉我我编码错误只是简单地运行（冻结）而没有结果。我会发布我的代码，以便我的情况可能更清楚。

P.S。如果有人可以帮我修改我的代码，并解释我做错了什么以及为什么，那将非常感谢！

谢谢大家！

    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

我会亲自在excel中编写公式，以确定是否需要删除行。（该行的任何列都包含您要查找的单词）。一旦我知道公式正常工作，我会在最后一栏中使用vba将其添加到文件中。

在最后一列中的公式后，我会对此行进行排序并删除我需要的任何行。然后删除新列并保存文件。

Answer 2

看看这个。这使用了FindNext和Offset（不完全确定为什么要在一个单元格上使用Find）这会找到值PURGE，如果它旁边的两个单元格是还PURGE然后删除该行。如果没有继续下去。

此行Do While strFile <> ""在某些时候需要Loop，但不确定您想要的位置。

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

Excel VBA：在Worksheet，offset列中查找值以查找相同的值

2 个答案: