如果一個單元格以某個單詞結尾，我該如何刪除整行？ 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