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

我有一个超过10,000行的Excel文件。 我想运行一个VBA脚本，删除所有行中列B 以单词reduce 结尾的行。 例如，如果我的专栏看起来像这样：

 CostReduce PriceReduce ReducePrice MaterialReduce InfrastructureReduce ReduceProfits ReduceOverhead 

我希望脚本运行并删除每个以Reduce结尾的单词。 所以输出将是：

 ReducePrice ReduceProfits ReduceOverhead 

我现在所拥有的脚本删除了包含单词reduce的所有行，我不知道如何才能改变它，所以它就是我想要的。

 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

使用Rightfunction，轻微改变你的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

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

Answer 3

此解决scheme使用Autofilter设置一个Range与Rows被删除，然后提出两种方法删除行：

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

在下面的代码中，两种方法都是“有效的”，您需要评论没有select的方法。

 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 

Answer 4

让它检查单元格中的最后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