は私が入力

Question

私は、このVBAコード

Sub DeleteRows() 
Dim rng As Range 
Dim InputRng As Range 
Dim DeleteRng As Range 
Dim DeleteStr As String 
xTitleId = "Delete" 
Set InputRng = Application.Selection 
Set InputRng = Application.InputBox("Range :", xTitleId, InputRng.Address, Type:=8) 
DeleteStr = Application.InputBox("Delete Text", xTitleId, Type:=2) 
For Each rng In InputRng 
    If rng.Value = DeleteStr Then 
     If DeleteRng Is Nothing Then 
      Set DeleteRng = rng 
     Else 
      Set DeleteRng = Application.Union(DeleteRng, rng) 
     End If 
    End If 
Next 
DeleteRng.EntireRow.Delete 
End Sub 

この1つは単語I入力のためのすべての行を削除を持っている他のすべての行を削除するVBAコードではなく、1を変更する必要があります。私は入力した単語以外のすべてを削除する必要があります。 ありがとうございます！

Answer 1

問題は、ユーザーが複数の列の範囲を選択できるようにすることです。 If rng.Value <> DeleteStr Thenで検索文字列が選択された行の1つのセルに存在し、同じ行の別のセルに存在しない場合、その行は削除対象としてマークされます。

したがって、各行を別々に考えてみましょう。その行の任意のセルが検索文字列と等しい場合、この

Sub DeleteRows() 
    Dim rng As Range, rw As Range 
    Dim delRow As Boolean 
    Dim InputRng As Range 
    Dim DeleteRng As Range 
    Dim DeleteStr As String 
    Dim xTitleId As String 

    xTitleId = "Delete" 
    Set InputRng = Application.Selection 
    Set InputRng = Application.InputBox("Range :", xTitleId, InputRng.Address, Type:=8) 
    DeleteStr = Application.InputBox("Delete Text", xTitleId, Type:=2) 
    For Each rw In InputRng.Rows 
     delRow = True 
     For Each rng In rw.Cells 
      If rng.Value = DeleteStr Then 
       delRow = False 
       Exit For 
      End If 
     Next 
     If delRow Then 
      If DeleteRng Is Nothing Then 
       Set DeleteRng = rw.EntireRow 
      Else 
       Set DeleteRng = Application.Union(DeleteRng, rw.EntireRow) 
      End If 
     End If 
    Next 
    If Not DeleteRng Is Nothing Then 
     DeleteRng.Delete 
    End If 
End Sub 

Answer 2

のような削除から

何かから行を除外するこれは、仕事をする必要があります。 EntireRowが間違った場所にありました。

Sub DeleteRows() 
    ' 03 Apr 2017 

    Dim Cell As Range 
    Dim InputRng As Range 
    Dim DeleteRng As Range 
    Dim DeleteStr As String 
    Dim xTitleId As String 

    xTitleId = "Delete" 
    Set InputRng = Application.InputBox("Range :", xTitleId, Selection.Address, Type:=8) 
    DeleteStr = InputBox("Delete Text", xTitleId) 
    For Each Cell In InputRng 
     If StrComp(Cell.Value, DeleteStr, vbTextCompare) Then 
      If DeleteRng Is Nothing Then 
       Set DeleteRng = Cell.EntireRow 
      Else 
       Set DeleteRng = Application.Union(DeleteRng, Cell.EntireRow) 
      End If 
     End If 
    Next 
    DeleteRng.Delete 
End Sub 

Answer 3

コードは行をループするため、最適ではありません。

速いバージョンでは、COUNTIFを使用して、削除されていない条件が行で満たされているかどうかを確認し、AutoFilterを使用して条件が見つからない行を削除できます。

これを手動またはVBAで行うことができます。

データが列B：Dにあった場合、このコードは作業式を新しい列に挿入し、条件が真である行を削除します。

=COUNTIF(B2:D2,"Your Condition")>0

コード

Sub Quicker() 

Dim rng1 As Range 
Dim DeleteStr As String 
Dim rng2 As Range 

Set rng1 = Application.InputBox("Range :", xTitleId, Selection.Address, , , , , 8) 
DeleteStr = Application.InputBox("Delete Text", "Delete", , , , , , 2) 

With rng1.Columns(1).Offset(0, rng1.Columns.Count) 
    .EntireColumn.Insert 
    .FormulaR1C1 = "=COUNTIF(RC[-" & rng1.Columns.Count + 1 & "]:RC[-2],""" & DeleteStr & """)>0" 
    .AutoFilter Field:=1, Criteria1:="FALSE" 
    'preserve header row  
    .Offset(1, 0).Resize(rng1.Rows.Count - 1, 1).EntireRow.Delete 
     On Error Resume Next 
    .EntireColumn.Delete 
    On Error GoTo 0 
End With 

End Sub