Question

我需要搜索H列并查找“AA”的所有实例。如果存在“AA”，则需要检查位于下面两行并留下七个单元格的单元格（即A列）。该单元格可以具有或不具有值“ - ”。如果它的值为“ - ”，则删除该单元格并继续检查A列。用“ - ”删除所有单元格，直到它到达空白单元格。此时它继续沿着H列继续寻找更多相同的东西。

Answer 1

我修改了第1至3点所述的代码（见注释）。我希望新代码完全符合您的要求。

Option Explicit
Sub DeleteUnderScoreRows()

  Dim Rng As Range
  Dim RowCrnt As Long
  Dim RowLastAA As Long

  ' Add a quote to the beginning of the statement if you
  ' want to watch the rows disppear
  Application.ScreenUpdating = False

  RowLastAA = 0
  RowCrnt = Rows.Count      ' Start search from row 1

  With Sheets("Sheet1")
    Do While True
      ' * Find next row after RowCrnt that contains "AA" in column H
      ' * The first parameter of Find is the string to be searched for.
      ' * The second parameter is the cell from which the search is to
      '   start.
      ' * The last parameter I have used is the direction of the search.
      '   I have used xlNext meaning down or right.  xlPrevious means
      '   up or left.
      ' * Find does not look at the start cell.  It starts at the next
      '   cell in the chosen direction.  It continues until it finds the
      '   required string or until it reaches the bottom or top when it
      '   wraps.  I have intialised RowCrnt (the start row) to the bottom
      '   row so the search start from the next row in the chosen
      '   direction which is 1.
      Set Rng = .Columns("H").Find("AA", .Cells(RowCrnt, "H"), _
                                    xlFormulas, xlWhole, xlByRows, xlNext)
      If Rng Is Nothing Then
        ' No AAs found
        Exit Sub
      End If
      RowCrnt = Rng.Row
      If RowCrnt <= RowLastAA Then
        ' Find wraps so when it reaches the bottom it starts again at
        ' the top.  I have recorded the row of the last AA found in
        ' RowLastAA.  If RowCrnt = RowLastAA, Excel has wrapped to the
        ' only AA in the sheet.  If RowCrnt < RowLastAA, there are two
        ' or more AAs and Excel has wrapped to the first one.
        Exit Sub
      End If
      'Loop deleting underscore rows until find a non-underscore row
      Do While .Cells(RowCrnt + 2, 1).Value = "'-" Or _
               .Cells(RowCrnt + 2, 1).Value = "-"
        .Cells(RowCrnt + 2, 1).EntireRow.Delete
      Loop
      RowLastAA = RowCrnt   ' Record this AA row so can detect loop
    Loop
  End With


  Application.ScreenUpdating = True

End Sub

Answer 2

Dim FindAA As Range
Dim ColA As Range
Dim FirstAddress As String

Set FindAA = Sheet1.Columns("H:H").Find("AA", , xlFormulas, xlWhole, _
    xlByRows, xlNext, True)
If FindAA Is Nothing Then Exit Sub
FirstAddress = FindAA.Address
Do
    Set ColA = FindAA.Offset(2, -7)
    While ColA = "--"
        ColA.Rows.Delete
        Set ColA = FindAA.Offset(2, -7)
    Wend
    Set FindAA = Sheet1.Columns("H:H").FindNext(FindAA)
Loop While Not FindAA Is Nothing And FindAA.Address <> FirstAddress

Set FindAA = Nothing
Set ColA = Nothing

检查列H的特定值，并根据不同的值和循环删除单元格

2 个答案: