Question

我正在尝试读取一个具有数值的列，以指示是否搜索该行以查看该行的指定范围内是否包含任何数据。如果范围内不包含任何数据，请选择要删除的行。一旦循环通过工作表，就会删除许多行。

例如，在列“C”中找到值“0”时，搜索该行以查看单元格中是否包含任何数据，在该行中搜索空单元格的单元格范围是D：AM 。如果范围中的单元格为空，则选择该行并将其删除。整个行都可以删除。我需要为整个工作表执行此操作，最多可包含20,000行。我遇到的问题是，一旦找到值0，就让宏读取行，以确定单元格范围（D：AM）是否为空。这是我到目前为止的代码：

Option Explicit
Sub DeleteBlankRows()
  'declare variables
  Dim x, curVal, BlankCount As Integer
  Dim found, completed As Boolean
  Dim rowCount, rangesCount As Long
  Dim allRanges(10000) As Range
  'set variables
  BlankCount = 0
  x = 0
  rowCount = 2
  rangesCount = -1
  notFirst = False
  'Select the starting Cell
  Range("C2").Select
  'Loop to go down Row C and search for value
  Do Until completed
     rowCount = rowCount + 1

     curVal = Range("C" & CStr(rowCount)).Value
     'If 0 is found then start the range counter
     If curVal = x Then
         found = True
         rangesCount = rangesCount + 1
         'reset the blanks counter
         BlankCount = 0
         'Populate the array with the correct range to be selected
         Set allRanges(rangesCount) = Range("D" & CStr(rowCount) & ":AM" & CStr(rowCount))

     ElseIf (found) Then
        'if the cell is blank, increment the counter
        If (IsEmpty(Range("I" & CStr(rowCount)).Value)) Then BlankCount = BlankCount + 1
        'if counter is greater then 20, reached end of document, stop selection
        If BlankCount > 20 Then Exit Do
     End If
     'In the safest-side condition to avoid an infinite loop in case of not of finding what is intended.
     If (rowCount >= 25000) Then Exit Do
  Loop

  If (rangesCount > 0) Then
     'Declare variables
     Dim curRange As Variant
     Dim allTogether As Range
     'Set variables
     Set allTogether = allRanges(0)
     For Each curRange In allRanges
           If (Not curRange Is Nothing) Then Set allTogether = Union(curRange, allTogether)
     Next curRange
     'Select the array of data
     allTogether.Select
     'delete the selection of data
     'allTogether.Delete
  End If
End Sub

文档的结尾由C列确定，当它遇到20个或更多空白单元格时，工作表已到达其末尾。提前感谢您的意见！

Answer 1

这对你有用。我已经对代码进行了评论，以帮助明确：

Sub DeleteBlankRows()

    Dim rngDel As Range
    Dim rngFound As Range
    Dim strFirst As String

    'Searching column C
    With Columns("C")
        'Find "0" in column C
        Set rngFound = .Find(0, .Cells(.Cells.Count), xlValues, xlWhole)
        If Not rngFound Is Nothing Then
            'Remember first one found
            strFirst = rngFound.Address
            Do

                'Check if there is anything within D:AM on the row of this found cell
                If WorksheetFunction.CountA(Intersect(rngFound.EntireRow, .Parent.Range("D:AM"))) = 0 Then
                    'There is nothing, add this row to rngDel
                    Select Case (rngDel Is Nothing)
                        Case True:  Set rngDel = rngFound
                        Case Else:  Set rngDel = Union(rngDel, rngFound)
                    End Select
                End If

                'Find next "0"
                Set rngFound = .Find(0, rngFound, xlValues, xlWhole)

            'Advance loop; exit when back to the first one
            Loop While rngFound.Address <> strFirst
        End If
    End With

    'Delete all rows added to rngDel (if any)
    If Not rngDel Is Nothing Then rngDel.EntireRow.Delete

End Sub

Excel宏，读取工作表，删除列中没有基于数据值的行

1 个答案: