自动过滤柱A& AS针对特定细胞标准并删除。大变化的数据

时间:2018-04-20 01:48:03

标签: vba excel-vba excel

我的代码可以删除SAME数据转储。

我想让它适用于不同大小的数据。我只需要过滤其中cell = 2的A列,然后过滤,过滤所有11和更大数字的列AS。

我无法弄清楚如何将其输入“criterial:= Array(_)部分:查看下面的工作代码以获取示例静态数据集:

Rows("1:1").Select
    Selection.AutoFilter
    Range("A2").Select
    ActiveSheet.Range("$A$1:$JS$15900").AutoFilter Field:=1, Criteria1:="2"
    ActiveWindow.SmallScroll ToRight:=17
    ActiveSheet.Range("$A$1:$JS$15900").AutoFilter Field:=45, Criteria1:=Array( _
        "11", "12", "13", "14", "999"), Operator:=xlFilterValues
    Range("A2310").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range("A2310:AU15724").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.EntireRow.Delete
    Range("A15476").Select
    ActiveSheet.ShowAllData
    Rows("1:1").Select

非常感谢!

2 个答案:

答案 0 :(得分:1)

这将使用ActiveSheet

  • 如果col A包含值为= 2的单元格,则会自动筛选它:Col A = 2
  • 如果col AS包含值为> 10的单元格,则会自动筛选它:Col AS > 10
  • 删除以START_DEL_ROW
  • 开头的所有剩余可见行
Option Explicit

Public Sub FilterAndDelete()
    Const Col1 = 1              'A
    Const Col2 = 45             'AS
    Const Col1_COND = 2         'A criteria
    Const Col2_COND = ">10"     'AS criteria
    Const START_DEL_ROW = 11    'First deleted visible row (to last used row)

    Dim ws As Worksheet, lr As Long, ur As Range, vis As Range, keep As Range

    Set ws = ActiveSheet
    lr = ws.Cells(ws.Rows.Count, Col1).End(xlUp).Row
    Set ur = ws.Range(ws.Cells(1, Col1), ws.Cells(lr, Col2))

    'If col A has cells with val 2
    If WorksheetFunction.CountIf(ur.Columns(Col1), Col1_COND) > 0 Then
        Application.ScreenUpdating = False
        ur.AutoFilter Field:=Col1, Criteria1:=Col1_COND     'Filter col A
        Set vis = ur.SpecialCells(xlCellTypeVisible)

        'If col AS has cells with val > 10
        If WorksheetFunction.CountIf(vis.Columns(Col2), Col2_COND) > 0 Then
            vis.AutoFilter Field:=Col2, Criteria1:=Col2_COND, Operator:=xlAnd
            Set keep = ur.Range(ur.Cells(1, Col1), ur.Cells(START_DEL_ROW - 1, Col1))
            keep.Rows.Hidden = True 'Delete all visible rows (except topof START_DEL_ROW)
            If CBool(Application.Subtotal(103, ur.Cells)) Then
                ur.SpecialCells(xlCellTypeVisible).EntireRow.Delete
            End If
            keep.Rows.Hidden = False
        End If
        ur.AutoFilter
        Application.ScreenUpdating = True
    End If
End Sub

答案 1 :(得分:0)

你可以用这个

    With Intersect(ActiveSheet.UsedRange, Range("A:AS")) ' reference its columns A:AS range
        .AutoFilter Field:=1, Criteria1:="2"  ' filter referenced range column 1 cells with "2"
        .AutoFilter Field:=.Columns.Count, Criteria1:=">11"  ' filter referenced range last column with ">11"
        If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete 'if any filtered cells other than delete their entire row
    End With
    ActiveSheet.AutoFilterMode = False ' remove autofilter