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

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

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

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