Question

我有一个包含6个表的工作表，每个表使用B：N列。每列B列包含从1AM到12AM的小时数。我需要删除单元格AF2上包含特定值的单元格下面的所有行。例如，AF2包含5PM。每个表B列上下午5点以下的所有行均应删除。所有表都有标题，例如第一个表是Cashiers，第二个表是Waiters，依此类推。

这是我到目前为止所拥有的：

Set sh = Sheets("report")
valueToFind = sh.Range("AF2").Value

Do
Set Cell1 = sh.Range("B:B").Find(What:=valueToFind, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Cell1 Is Nothing Then Exit Do
Set Cell2 = sh.Range(Cell1.Address & ":B" & sh.UsedRange.Rows.Count).End(xlDown)
    If IsEmpty(Cell1.Offset(1, 0)) Then
        Exit Sub
    Else
        Rows(Cell1.Row & ":" & Cell2.Row).Delete
    End If
Loop

此代码的问题在于，它还按照单元格AF2上指示的时间删除了该行，当它应该向下移动一个单元格然后删除该行开始时就删除了。

有什么建议吗？

Answer 1

在尝试此代码之前，请备份您的书：

阅读代码的注释并进行调整以适合您的需求。（注释/取消注释删除先前范围值的行）

编辑：请参见下面的两个版本

版本1

此代码从源工作表中复制值，然后循环遍历表（列表对象），并根据需要的时间删除该表下面的行

Public Sub CopyTablesDeleteRows()

    ' Declare objects
    Dim mainSheet As Worksheet
    Dim evalSheet As Worksheet

    Dim evalTable As ListObject

    Dim sourceRange As Range
    Dim destinationRange As Range
    Dim filterCell As Range
    Dim foundCell As Range

    ' Declare other variables
    Dim mainSheetName As String
    Dim reportSheetName As String
    Dim sourceRangeAddress As String
    Dim filterCellAddress As String

    ' Adjust these next lines to fit your needs
    mainSheetName = "Main report"
    reportSheetName = "report"
    sourceRangeAddress = "B2:N84"
    filterCellAddress = "AF2"

    Set mainSheet = ThisWorkbook.Worksheets(mainSheetName)
    ' This is the source range where tables are located
    Set sourceRange = mainSheet.Range(sourceRangeAddress)

    Set evalSheet = ThisWorkbook.Worksheets(reportSheetName)
    Set destinationRange = evalSheet.Range(sourceRangeAddress)
    Set filterCell = evalSheet.Range(filterCellAddress)

    ' Delete previous values
    destinationRange.Clear

    ' Copy source range to destination
    sourceRange.Copy destinationRange

    ' Loop through each table in the worksheet
    For Each evalTable In evalSheet.ListObjects

        ' Find the filter cell value in the table's first column (see ListColumns(1) in next line)
        Set foundCell = evalTable.ListColumns(1).DataBodyRange.Find(What:=Format(filterCell.Value, "hh:mm AM/PM"), _
                                                                    LookIn:=xlValues, lookat:=xlWhole, _
                                                                    searchorder:=xlByRows, SearchDirection:=xlNext, _
                                                                    MatchCase:=False, SearchFormat:=False)
        ' If filter cell value is found inside table's column
        If Not foundCell Is Nothing Then

            ' Delete rows from that cell to the last one in table
            evalTable.DataBodyRange.Rows(foundCell.Row - evalTable.HeaderRowRange.Row + 1 & ":" & evalTable.DataBodyRange.Rows.Count).Delete
        End If

    Next evalTable

End Sub

版本2

此代码适用于复制粘贴值格式（意味着您松开了结构化表的功能），然后根据搜索到的时间值找到结束行和开始行，最后删除范围（代码很长，因为您已定位桌子底部的12:00 AM，有些桌子不是全天营业）

Public Sub DeleteRows()

    Dim reportSheet As Worksheet

    Dim reportSheetName As String
    Dim valueToFindRangeAddr As String
    Dim lookInColumn As String

    Dim valueToFind As Date

    Dim lastRow As Long
    Dim startRow As Long
    Dim endRow As Long

    Dim generalCounter As Long
    Dim counter As Long
    Dim rangeCounter As Long

    Dim deleteRangeRows() As Variant
    Dim rangeRows() As Variant

    reportSheetName = "report"
    valueToFindRangeAddr = "AF2"
    lookInColumn = "B"

    ' Initialize objects
    Set reportSheet = ThisWorkbook.Worksheets(reportSheetName)
    valueToFind = reportSheet.Range(valueToFindRangeAddr).Value2

    ' Get last cell with values in lookInColumn
    lastRow = reportSheet.Cells(reportSheet.Rows.Count, reportSheet.Columns(lookInColumn).Column).End(xlUp).Row

    If Format(valueToFind, "hh:mm AM/PM") = Format(TimeValue("12:00 AM"), "hh:mm AM/PM") Then
        MsgBox "Value to find is last time in tables"
        Exit Sub
    End If

    For generalCounter = lastRow To 1 Step -1

        ReDim Preserve deleteRangeRows(rangeCounter)
        startRow = 0
        endRow = 0

        ' Get row of last cell with time
        For counter = generalCounter To 1 Step -1
            If IsTime(reportSheet.Range(lookInColumn & counter).Value) = True Then
                endRow = counter
                Exit For
            End If
        Next counter

        ' Get row of cell with value to find
        For counter = endRow - 1 To 1 Step -1
            If reportSheet.Range(lookInColumn & counter).Value = valueToFind Then
                startRow = counter + 1
                Exit For
            ElseIf IsTime(reportSheet.Range(lookInColumn & counter).Value) = False Then
                Exit For
            End If
        Next counter

        If startRow > 0 And startRow <= endRow Then
            deleteRangeRows(rangeCounter) = Array(startRow, endRow)
            rangeCounter = rangeCounter + 1
            generalCounter = counter
        Else
            generalCounter = counter + 1
        End If



    Next generalCounter

    ' Delete rows ranges recorded
    For counter = 0 To UBound(deleteRangeRows) - 1

        startRow = deleteRangeRows(counter)(0)
        endRow = deleteRangeRows(counter)(1)

        reportSheet.Rows(startRow & ":" & endRow).Delete

    Next counter

    MsgBox "Finished"

End Sub

' Credits: https://stackoverflow.com/a/52805191/1521579
Function IsTime(Expression As Variant) As Boolean
    If IsDate(Expression) Then
        IsTime = (Int(CSng(CDate(Expression))) = 0)
    End If
End Function

让我知道它是否有效，并记住标记答案以帮助他人

删除未使用的表行

1 个答案: