VBAヘルプ。複数の条件に基づいて行を削除

Question

私は、不要なデータの行を削除し、複数の基準に基づいて行うデータの行を保持することによって、ワークシートをクリーンアップするためのVBAヘルプを探しています。

列Aに「小計：」、列Cに数値を含む行をすべて保持して、その条件に一致しない他の行をすべて削除したいと考えています。

Before Cleanup

Desired Result Requested

Answer 1

私は仕事を得ることができるはずの機能を書きました。

サブ関数から関数を呼び出し、テストする列番号（「A」は1）、テストする値（空白は「」）、ワークシート名テストしたい最後の引数はブール値で、trueの場合は条件の値の一致時に削除されます。それ以外の場合は削除されません。ですから、あなたの上に要求された何をすべきか

Function DeleteCol(iCol As Integer, strCriteria As String, strWSName As String, bPositive As Boolean) 

    Dim iLastCol As Integer 
    Dim wsUsed As Worksheet 

    Set wsUsed = ThisWorkbook.Worksheets(strWSName) 
    iLastRow = wsUsed.Cells(Rows.Count, iCol).End(xlUp).Row 
    For i = iLastRow To 1 Step -1 
    With wsUsed.Cells(i, iCol) 
     If bPositive Then 
     If .Value = strCriteria Then .EntireRow.Delete 
     Else 
     If .Value <> strCriteria Then .EntireRow.Delete 
     End If 
    End With 
    Next i 

End Function 

を行うことができます：

Sub Delete() 
Call DeleteCol(1, "Subtotal:", "CoolSheetName", False) 
Call DeleteCol(3, "", "CoolSheetName", True) 
End Sub 

Answer 2

を次の（コメント）コード試してみたいことがあります。

Option Explicit 

Sub main() 
    With Worksheets("MySheetName") '<--| change "MySheetName" to your actual sheet name 
     With Intersect(.UsedRange, .Columns("A:C")) 
      .AutoFilter Field:=1, Criteria1:="<>Subtotal" '<--| filter column "A" cells not containing "Subtotal" 
      If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then .Offset(1).Resize(.rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete '<--| delete any filtered cell row 
      .AutoFilter '<--| show all data back 
      With .Offset(1, 2).Resize(.rows.Count - 1, 1) '<--| consider column "C" cell from header row (excluded) down 
       DeleteRows .Cells, xlCellTypeConstants, xlTextValues '<--| delete any "constant text" cell row 
       DeleteRows .Cells, xlCellTypeFormulas, xlTextValues '<--| delete any "formula text" cell row 
       DeleteRows .Cells, xlCellTypeBlanks, xlTextValues '<--| delete any "blank" cell row 
      End With 
     End With 
    End With 
End Sub 

Sub DeleteRows(rng As Range, cellType As XlCellType, cellsValue As XlSpecialCellsValue) 
    Dim f As Range 

    Set f = rng.SpecialCells(cellType, cellsValue) 
    If Not f Is Nothing Then f.EntireRow.Delete 
End Sub