Come eliminare righe in un elenco di Excel Oggetto basato su criteri che utilizzano VBA?

Question

Ho una tabella in Excel denominata tblFruits con 10 colonne e voglio eliminare tutte le righe in cui la colonna Fruit contiene Apple. Come posso fare questo?

Answer 1

le seguenti opere: sub

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 

Il sub possono essere eseguiti in questo modo:

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

Answer 2

Bene, sembra che la proprietà .listrows è limitata a uno una lista riga o tutta la lista righe .

modo più semplice che ho trovato per aggirare questo è stato di:

1. Impostazione di una colonna con una formula che fa notare a me tutte le righe vorrei eliminare (potrebbe non essere necessario la formula, in questo caso)

2. Ordinamento ListObject su tale colonna specifica (preferibilmente facendo sì che il mio valore da cancellare sarebbe alla fine smistamento)

3. Recupero del indirizzo della serie di listrows I del del ete

4. Infine, cancellando l'intervallo recuperato, spostando le celle verso l'alto.

In questo specifico pezzo di codice:

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 

Speranza che aiuta ...