通过查找列中的列和值，使用VBA删除Excel中的行

I am trying to build a macro which will find a column with the header "Total Labor" and delete all rows which have "0" in that column. I am generating multiple reports and the "Total Labor" column will change position so that's why I need the find. So far I have this code but when I run it nothing happens. Any help is appreciated.

我正在尝试构建一个宏,它将找到一个标题为“Total Labor”的列,并删除该列中包含“0”的所有行。我正在生成多个报告,“总人工”列将更改位置,这就是我需要查找的原因。到目前为止我有这个代码,但是当我运行它时没有任何反应。任何帮助表示赞赏。

Sub DeleteRows()
Dim FoundCell As Range
Dim rng As Range
Application.ScreenUpdating = False
Set rng = Worksheets(ActiveSheet.Name).Range("A1:BB100").Find(what:="Total Labor", _
    LookAt:=xlWhole, MatchCase:=False)
Set FoundCell = rng.Find(what:="0")
Do Until FoundCell Is Nothing
    FoundCell.EntireRow.Delete
    Set FoundCell = rng.FindNext
Loop

End Sub

3 个解决方案

#1

First: if you set Application.ScreenUpdating = False be sure that you reset it to True before the sub ends. If your macro crashes you could find yourself unable to work with the application until you restart Excel or run another macro that sets Application.ScreenUpdating = True

第一:如果你设置Application.ScreenUpdating = False,请确保在子结束之前将其重置为True。如果您的宏崩溃,您可能会发现自己无法使用该应用程序,直到您重新启动Excel或运行另一个设置Application.ScreenUpdating = True的宏

Now, to answer your question: The problem with your code is that rng as defined in your code is only going to be the cell containing "Total Labor". When you search for a value of "0" in that range, the line Set FoundCell = rng.Find(what:="0") evaluates to "Nothing", so when you start the do loop, it meets the criterion of FoundCell Is Nothing and immediately goes to End Sub.

现在,回答你的问题:代码的问题在于代码中定义的rng只是包含“Total Labor”的单元格。当您在该范围内搜索值“0”时,行Set FoundCell = rng.Find(what:=“0”)计算为“Nothing”,因此当您启动do循环时,它符合FoundCell的标准什么都没有,立即转到End Sub。

Something like this should do the trick:

像这样的东西应该做的伎俩:

    Sub DeleteRows2()

    On Error GoTo ErrorHandler

    Application.ScreenUpdating = False

    '~~>dim variables and set initial values
        Dim rTotalLaborHeader As Range
            Set rTotalLaborHeader = Worksheets(ActiveSheet.Name).Range("A1:BB100").Find(what:="Total Labor", _
                LookAt:=xlWhole, MatchCase:=False)
        Dim rTotalLaborColumn As Range
            Set rTotalLaborColumn = Range(Cells(2, rTotalLaborHeader.Column), Cells(1048576, rTotalLaborHeader.Column).End(xlUp))
            'Set rTotalLaborColumn = Range(rTotalLaborHeader.Offset(1, 0), rTotalLaborHeader.End(xlDown))
        Dim rLaborRow As Range

    '~~>Loop to delete rows with zero Total Labor
        For Each rLaborRow In rTotalLaborColumn
            If rLaborRow.Value = 0 Then rLaborRow.EntireRow.Delete
        Next rLaborRow

CleanupAndExit:
    Application.ScreenUpdating = True
    Exit Sub

ErrorHandler:
    Resume CleanupAndExit

End Sub

#2

How about:

Sub DeleteRow()
    Dim colly As Long, killer As Range, nRow As Long
    colly = 0
    For i = 1 To Columns.Count
        If Cells(1, i).Value = "Total Labor" Then
            colly = i
            Exit For
        End If
    Next i
    If colly = 0 Then
        MsgBox "Header not found"
        Exit Sub
    End If
    nRow = Cells(Rows.Count, colly).End(xlUp).Row
    For i = 1 To nRow
        If Cells(i, colly).Value = 0 Then
            If killer Is Nothing Then
                Set killer = Cells(i, colly)
            Else
                Set killer = Union(killer, Cells(i, colly))
            End If
        End If
    Next i
    If killer Is Nothing Then
    Else
        killer.EntireRow.Delete
    End If
End Sub

#3

You need to replicate the FindAll functionality that the Excel UI Provides. Here's a code-list for achieving that in VBA. Save this to a .bas file, then call it in your macro after you locate 'Total Labor' and then look through the range you get back from FindAll and execute .Delete on them.

您需要复制Excel UI提供的FindAll功能。这是在VBA中实现这一目标的代码列表。将其保存到.bas文件,然后在找到“总人工”后在宏中调用它,然后查看从FindAll返回的范围并对它们执行.Delete。

Sub DeleteRows()

Dim FoundCell As Range
Dim rng As Range

Application.ScreenUpdating = False

Set rng = Worksheets(ActiveSheet.Name).Range("A1:BB100").Find(what:="Total Labor", _
    LookAt:=xlWhole, MatchCase:=False)

If rng Is Nothing Then
    Msgbox "Total Labor Not Found"
Else
    Set SearchRange = rng.EntireColumn
    FindWhat = "0"
    Set FoundCells = FindAll(SearchRange:=SearchRange, _
                            FindWhat:=FindWhat, _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByColumns, _
                            MatchCase:=False, _
                            BeginsWith:=vbNullString, _
                            EndsWith:=vbNullString, _
                            BeginEndCompare:=vbTextCompare)

    If FoundCells Is Nothing Then
        Debug.Print "Value Not Found"
    Else
        For Each FoundCell In FoundCells
            FoundCell.EntireRow.Delete
        Next FoundCell
    End If

End If

End Sub

FindAll Source Code: http://www.cpearson.com/excel/findall.aspx

FindAll源代码:http://www.cpearson.com/excel/findall.aspx

Function FindAll(SearchRange As Range, _
                FindWhat As Variant, _
               Optional LookIn As XlFindLookIn = xlValues, _
                Optional LookAt As XlLookAt = xlWhole, _
                Optional SearchOrder As XlSearchOrder = xlByRows, _
                Optional MatchCase As Boolean = False, _
                Optional BeginsWith As String = vbNullString, _
                Optional EndsWith As String = vbNullString, _
                Optional BeginEndCompare As VbCompareMethod = vbTextCompare) As Range
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' FindAll
' This searches the range specified by SearchRange and returns a Range object
' that contains all the cells in which FindWhat was found. The search parameters to
' this function have the same meaning and effect as they do with the
' Range.Find method. If the value was not found, the function return Nothing. If
' BeginsWith is not an empty string, only those cells that begin with BeginWith
' are included in the result. If EndsWith is not an empty string, only those cells
' that end with EndsWith are included in the result. Note that if a cell contains
' a single word that matches either BeginsWith or EndsWith, it is included in the
' result.  If BeginsWith or EndsWith is not an empty string, the LookAt parameter
' is automatically changed to xlPart. The tests for BeginsWith and EndsWith may be
' case-sensitive by setting BeginEndCompare to vbBinaryCompare. For case-insensitive
' comparisons, set BeginEndCompare to vbTextCompare. If this parameter is omitted,
' it defaults to vbTextCompare. The comparisons for BeginsWith and EndsWith are
' in an OR relationship. That is, if both BeginsWith and EndsWith are provided,
' a match if found if the text begins with BeginsWith OR the text ends with EndsWith.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim FoundCell As Range
Dim FirstFound As Range
Dim LastCell As Range
Dim ResultRange As Range
Dim XLookAt As XlLookAt
Dim Include As Boolean
Dim CompMode As VbCompareMethod
Dim Area As Range
Dim MaxRow As Long
Dim MaxCol As Long
Dim BeginB As Boolean
Dim EndB As Boolean


CompMode = BeginEndCompare
If BeginsWith <> vbNullString Or EndsWith <> vbNullString Then
    XLookAt = xlPart
Else
    XLookAt = LookAt
End If

' this loop in Areas is to find the last cell
' of all the areas. That is, the cell whose row
' and column are greater than or equal to any cell
' in any Area.

For Each Area In SearchRange.Areas
    With Area
        If .Cells(.Cells.Count).Row > MaxRow Then
            MaxRow = .Cells(.Cells.Count).Row
        End If
        If .Cells(.Cells.Count).Column > MaxCol Then
            MaxCol = .Cells(.Cells.Count).Column
        End If
    End With
Next Area
Set LastCell = SearchRange.Worksheet.Cells(MaxRow, MaxCol)

On Error GoTo 0
Set FoundCell = SearchRange.Find(what:=FindWhat, _
        after:=LastCell, _
        LookIn:=LookIn, _
        LookAt:=XLookAt, _
        SearchOrder:=SearchOrder, _
        MatchCase:=MatchCase)

If Not FoundCell Is Nothing Then
    Set FirstFound = FoundCell
    Do Until False ' Loop forever. We'll "Exit Do" when necessary.
        Include = False
        If BeginsWith = vbNullString And EndsWith = vbNullString Then
            Include = True
        Else
            If BeginsWith <> vbNullString Then
                If StrComp(Left(FoundCell.Text, Len(BeginsWith)), BeginsWith, BeginEndCompare) = 0 Then
                    Include = True
                End If
            End If
            If EndsWith <> vbNullString Then
                If StrComp(Right(FoundCell.Text, Len(EndsWith)), EndsWith, BeginEndCompare) = 0 Then
                    Include = True
                End If
            End If
        End If
        If Include = True Then
            If ResultRange Is Nothing Then
                Set ResultRange = FoundCell
            Else
                Set ResultRange = Application.Union(ResultRange, FoundCell)
            End If
        End If
        Set FoundCell = SearchRange.FindNext(after:=FoundCell)
        If (FoundCell Is Nothing) Then
            Exit Do
        End If
        If (FoundCell.Address = FirstFound.Address) Then
            Exit Do
        End If

    Loop
End If

Set FindAll = ResultRange

End Function