如果一个单元格以某个单词结尾，我该如何删除整行？ VBA

Question

我有一个超过10,000行的excel文件。我想运行一个VBA脚本，删除所有列B结束单词reduce中的行。例如，如果我的专栏是这样的：

CostReduce 
PriceReduce 
ReducePrice 
MaterialReduce 
InfrastructureReduce 
ReduceProfits 
ReduceOverhead 

我想脚本运行，删除具有在Reduce结尾的单词中的每一行。因此，输出将是：

ReducePrice 
ReduceProfits 
ReduceOverhead 

，我现在所拥有的脚本删除包含单词减少所有行，我不知道我该怎么去，因此我想要做什么改变它。

Sub DeleteReduce() 

Dim ContainWord As String 

Dim i As Integer 
i = 2 

ContainWord = "reduce" 

Do While Range("B" & i) <> "" 
    If Not Range("B" & i).Find(ContainWord) Is Nothing Then 
     Range("B" & i).EntireRow.Delete 
    Else 
     i = i + 1 
    End If 
Loop 
Range("B2").Select 
End Sub 

Answer 1

使用Right功能，小的改动你的VB：

Sub DeleteReduce() 

Dim ContainWord As String 

Dim i As Integer 
i = 2 

ContainWord = UCase("reduce") 

Do While Range("B" & i) <> "" 
    If UCASE(right(Range("B" & i).value,len(ContainWord))) = ContainWord Then 
     Range("B" & i).EntireRow.Delete 
    Else 
     i = i + 1 
    End If 
Loop 
Range("B2").Select 
End Sub 

更新，删除区分大小写

Answer 2

让它检查单元格中的最后6个字符，看它们是否匹配Reduce。

Right(Range("B" & i),6) = "Reduce"

Sub DeleteReduce() 
Dim ContainWord As String 
Dim i As Integer 

    ContainWord = "Reduce" 

    Do While Range("B" & i) <> "" 
    If Right(Range("B" & i),6) = ContainWord Then 
     Range("B" & i).EntireRow.Delete 
    Else 
     i = i + 1 
    End If 
    Loop 
    Range("B2").Select 
End Sub 

Answer 3

你真的需要一个脚本？用简单= IF（RIGHT（B1，6）=“reduce”，“yes”，“no”）引入另一列并应用一个过滤器，然后删除具有“yes”值的行是不够的吗？

Answer 4

该解决方案使用Autofilter设置与Rows一个Range被删除，然后介绍了两种方法来删除行：

1. 删除整个范围内的一次：但是这取决于量，这可能是缓慢的区域，文件大小等。
2. 以升序显示区域的删除结果（从下到上）。

这两种方法在下面的代码中都是“活动的”，您需要评论没有选择的方法。

Sub Rows_Delete_EndingWord_Published() 
Dim sCriteria As String 
sCriteria = "Reduce" 'Change as required 
Dim rDta As Range, rTmp As Range 
Dim l As Long 

    Application.Calculate 
    Application.EnableEvents = False 
    Application.Calculation = xlCalculationManual 
    Application.ScreenUpdating = False 
    Application.DisplayAlerts = False 

    Rem Set Data Range 
    With ThisWorkbook.Sheets("Sht(0)") 'Change as required 
     If Not (.AutoFilter Is Nothing) Then .Cells(1).AutoFilter 
     Set rDta = Range(.Cells(1, 2), .Cells(1, 2).End(xlDown)) 
    End With 

    Rem Filter Data Range & Set Resulting Range 
    With rDta 
     Set rTmp = .Offset(1, 0).Resize(-1 + .Rows.Count, 1) 
     .AutoFilter Field:=1, Criteria1:="=*" & sCriteria 
     On Error Resume Next 
     Set rTmp = rTmp.SpecialCells(xlCellTypeVisible) 
     On Error GoTo 0 
     .AutoFilter 
    End With 

    Rem Delete Filtered Data 
    Rem Presenting two methods - need to uncomment the method chosen 
    If Not (rTmp Is Nothing) Then 

     Rem Method 1 - Deleting entire range at once 
     Rem However it could be slow depending on the quantity of areas, size of the file, etc. 
     rTmp.EntireRow.Delete 

     Rem Method 2 - Deleting the range by Area in Ascending Order (Bottom to Top) 
     For l = rTmp.Areas.Count To 1 Step -1 
      rTmp.Areas(l).EntireRow.Delete 
     Next 

    End If 

    Application.Calculation = xlCalculationManual 
    Application.ScreenUpdating = False 
    Application.DisplayAlerts = False 
    Application.EnableEvents = False 

End Sub