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

我需要search列H并find所有“AA”的实例。 如果存在“AA”,则需要检查位于下方两行的单元格,并留下七个单元格(即A列)。 这个单元格可能有也可能没有“ – ”的值。 如果它的值为“ – ”,则删除该单元格并继续检查A列。删除所有带“ – ”的单元格,直到到达空白单元格。 在这一点,它继续下降列H寻找更多的相同。

我已经按照第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 
 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