Jak usunąć wiersze w obiekcie ListView programu Excel na podstawie kryteriów przy użyciu języka VBA?

Question

Mam tabeli w programie Excel o nazwie tblFruits z 10 kolumn i chcę usunąć wiersze, gdzie Fruit kolumna zawiera Apple. Jak mogę to zrobić?

Answer 1

następujące prace podrzędne:

Private Sub deleteTableRowsBasedOnCriteria(tbl As ListObject, columnName As String, criteria As String) 

    Dim x As Long, lastrow As Long, lr As ListRow 
    lastrow = tbl.ListRows.Count 
    For x = lastrow To 1 Step -1 
     Set lr = tbl.ListRows(x) 
     If Intersect(lr.Range, tbl.ListColumns(columnName).Range).Value = criteria Then 
      'lr.Range.Select 
      lr.Delete 
     End If 
    Next x 

End Sub 

Sub można wykonać tak:

Dim tbl As ListObject 
Set tbl = ThisWorkbook.Worksheets("Sheet1").ListObjects("tblFruits") 
Call deleteTableRowsBasedOnCriteria(tbl, "Fruit", "Apple") 

Answer 2

Cóż, wydaje się, że nieruchomość .listrows jest ograniczona albo jedna lista wierszu lub Lista wszystkich wierszy .

Najprostszym sposobem znalazłem obejść ten był:

1. utworzenie kolumny z formułą, która przypomina mi wszystkich wierszy Chcę wyeliminować (może nie trzeba formułę, w tym przypadku)

2. sortowanie listobject na danej kolumny (najlepiej podejmowania go tak, że mój stosunek do usunięcia byłby na końcu sortowaniu)

3. Pobieranie adresu zakresie listrows I będzie del ete

4. Wreszcie, usunięcie zakresu pobranego, przenoszenie komórek w górę.

W tym szczególnym kawałek kodu:

Sub Delete_LO_Rows 
    Const ctRemove as string = "Remove" 'value to be removed 
    Dim myLO as listobject, r as long 
    Dim N as integer 'number of the listcolumn with the formula 

    Set myLo = Sheet1.ListObjects("Table1") 'listobject goes here 

    With myLO 
     With .Sort 
      With .SortFields 
       .Clear 
       .Add Key:=.HeaderRowRange(myLO.ListColumns(N)), SortOn:= _ 
       xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
      End With   
      .Header = xlYes 
      .MatchCase = False 
      .Orientation = xlTopToBottom 
      .SortMethod = xlPinYin 
      .Apply 
     End With 

     On Error GoTo NoRemoveFound 
     r = Application.WorksheetFunction.Match(ctRemove, .ListColumns(.ListColumns.Count).DataBodyRange, 0) 
     Range(.parent.name & "!" & .DataBodyRange(r, 1).Address & ":" & .DataBodyRange(.ListRows.Count, .ListColumns.Count).Address).Delete xlShiftUp 
'Added the .parent.name to make sure the address is on the correct sure, but it will fail if there are any spaces or characters on the sheet name that will make it need a pair of '. 
'The error is just to skip these two lines in case the match returns an error. There's likely a better/cleaner way to do that. 
NoRemoveFound: 
    End With 
End sub 

nadzieję, że to pomaga ...