セルが特定の単語で終了する場合、行全体を削除するにはどうすればよいですか？ VBA

Question

私は10,000行以上のExcelファイルを持っています。列Bがすべてreduceので終わるすべての行を削除するVBAスクリプトを実行したいと思います。たとえば私の列は次のように見える場合：私は実行してReduceで終わる単語を持つすべての行を削除するスクリプトを希望

CostReduce 
PriceReduce 
ReducePrice 
MaterialReduce 
InfrastructureReduce 
ReduceProfits 
ReduceOverhead 

。だから、出力は次のようになります。

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

、あなたのVBにマイナーチェンジをRight機能を使用します。

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

この溶液を、行を削除するには、2つの方法を提示し、その後、削除するRowsとRangeを設定するAutofilterを使用する：一度範囲全体を削除

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