删除特定单元格上方的Excel中的一列行

我目前是一个非常新手的程序员,但是我正在处理一个我需要删除行的excel电子表格。

例如。

<1> Title 1 xyz Title 2 xyz Title 3 xyz xyz xyz Title 4 xyz 

每行在Excel中都有一个新的行,其中大约有1412个。 我需要删除一些标题和内容,但保留其他人。 使用下面的代码我已经find并修改了,我已经能够删除单行内容的标题,但我不能使它在多行内容的标题,例如。 标题3和下面的3行内容。

任何援助将不胜感激


 Sub removeSingleRows() Const strTOFIND As String = "Title 1" Dim rngFound As Range, rngToDelete As Range Dim strFirstAddress As String Application.ScreenUpdating = False With Sheet1.Range("A:A") Set rngFound = .Find( _ What:=strTOFIND, _ Lookat:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=True) If Not rngFound Is Nothing Then Set rngToDelete = rngFound strFirstAddress = rngFound.Address Set rngFound = .FindNext(After:=rngFound) Do Until rngFound.Address = strFirstAddress Set rngToDelete = Application.Union(rngToDelete, rngFound) Set rngFound = .FindNext(After:=rngFound) Loop End If End With If Not rngToDelete Is Nothing Then rngToDelete.Offset(1, 0).EntireRow.Delete rngToDelete.EntireRow.Delete End If Application.ScreenUpdating = True End Sub 

像这样的东西

  • 通过一系列单词循环find
  • 更新多个search的范围逻辑

 Sub removeSingleRows() Dim strArr() Dim strArrE Dim rngFound As Range Dim rngToDelete As Range Dim strFirstAddress As String strArr = Array("Title 1", "Title 2", "Title 3") Application.ScreenUpdating = False For Each strArrE In strArr With Sheets(1).Range("A:A") Set rngFound = .Find(CStr(strArrE), , xlValues, xlWhole, xlByRows, xlNext, True) If Not rngFound Is Nothing Then If rngToDelete Is Nothing Then Set rngToDelete = rngFound Else Set rngToDelete = Application.Union(rngToDelete, rngFound) End If strFirstAddress = rngFound.Address Set rngFound = .FindNext(After:=rngFound) Do Until rngFound.Address = strFirstAddress Set rngToDelete = Application.Union(rngToDelete, rngFound) Set rngFound = .FindNext(After:=rngFound) Loop End If End With Set rngFound = Nothing Next If Not rngToDelete Is Nothing Then rngToDelete.Offset(1, 0).EntireRow.Delete rngToDelete.EntireRow.Delete End If Application.ScreenUpdating = True End Sub