VBA Hilfe. Zeilen löschen basierend auf mehreren Kriterien

Question

Ich suche nach einer VBA-Hilfe, um ein Arbeitsblatt zu bereinigen, indem ich Datenzeilen lösche, die ich nicht brauche, und die Datenzeilen auf der Grundlage mehrerer Kriterien aufbewahre.

Ich möchte jede Zeile, die gleich "Zwischensumme:" in Spalte A und jeder Zeile, die eine Zahl in Spalte C enthält, behalten, während alle anderen Zeilen löschen, die dieses Kriterium nicht entsprechen.

Before Cleanup

Desired Result Requested

Answer 1

Ich schrieb eine Funktion der in der Lage sein sollte, die Arbeit zu erledigen.

So können Sie die Funktion von einem Sub aufrufen und die Spalte Zahl, die Sie testen möchten (1 für "A"), den Wert, den Sie testen möchten ("" für leer), den Namen des Arbeitsblattes würde gerne testen. Das letzte Argument ist ein boolescher Wert, und wenn es wahr ist, wird es bei Übereinstimmung mit dem Wert in den Kriterien gelöscht, wenn nicht, wird es bei irgendetwas anderem gelöscht.

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 

So zu tun, was Ihnen angeforderte oben Sie tun können:

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

Answer 2

Sie möglicherweise die folgende (kommentiert) Code, um zu versuchen:

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