Excel vba를 사용하여 여러 기준 필터링

Excel vba를 사용하여 여러 기준 필터링

A, 1, 2, 3, 4, 5 A, B, C는 8입니다.
A, B, C는 1-5입니다.

이 작업은 다음 코드를 사용하여 수행할 수 있습니다.

My_Range.AutoFilter Field:=1, Criteria1:=Array("1", "2", "3","4","5"), _
    Operator:=xlFilterValues

그러나 코드는 변수 1~5를 필터링하여 표시합니다.

반대로 하고 싶지만, A, B, C를 걸러내고 변수 1~5를 표시함으로써 같은 결과를 얻을 수 있습니다.

이 코드를 사용해 보았습니다.

My_Range.AutoFilter Field:=1, Criteria1:=Array("<>A", "<>B", "<>C"), _
    Operator:=xlFilterValues

하지만 효과가 없었다.

이 코드를 사용할 수 없는 이유는 무엇입니까?

다음과 같은 에러가 발생합니다.

범위 클래스의 런타임 오류 1004 자동 필터 메서드가 실패했습니다.

이거 어떻게 해?

(실험 결과 - MSDN은 여기서 도움이 되지 않습니다) 직접적 방법은 없다고 생각합니다. ★★Criteria1 Array는 드롭다운 체크박스를 사용하는 것과 동일합니다.이것은 배열 내의 항목 중 하나와 일치하는 항목만을 기준으로 목록을 필터링하는 것입니다.

리터럴 values values interest interest interest 、 면면 、 。"<>A" ★★★★★★★★★★★★★★★★★」"<>B" 리스트와 는 「」라고 생각됩니다.

Range.AutoFilter Field:=1, Criteria1:="=<>A", Operator:=xlOr, Criteria2:="=<>B"

과가있있 있있있다다 의 값이 "<>C"또한 매크로를 기록하는 동안 세 가지 모두에 대해 필터링(체크박스를 사용하여)하면 매크로 레코더가 코드를 정확하게 복제하고 오류가 발생합니다.이데올로기 때문에VBA는 UI를 사용합니다.

어쨌든, 당신 문제로 돌아가죠.일부 기준과 동일하지 않은 값을 필터링할 수 있지만 사용자에게 적합하지 않은 값은 최대 2개입니다.

Range("$A$1:$A$9").AutoFilter Field:=1, Criteria1:="<>A", Criteria2:="<>B", Operator:=xlAnd

정확한 문제에 따라 몇 가지 해결 방법이 있습니다.

1. column예를 "B"와 .=ISNUMBER(A2) ★★★★★★★★★★★★★★★★★」=NOT(A2="A", A2="B", A2="C")에, 「」로 합니다.TRUE
2. 수 자동 와 함께 합니다.Criteria1:=">-65535"이.
3. 행을 숨기려면 VBA 서브를 작성합니다(자동 필터와 완전히 동일하지는 않지만 필요에 따라 충분할 수 있습니다).

예를 들어 다음과 같습니다.

Public Sub hideABCRows(rangeToFilter As Range)
  Dim oCurrentCell As Range
  On Error GoTo errHandler

  Application.ScreenUpdating = False
  For Each oCurrentCell In rangeToFilter.Cells
    If oCurrentCell.Value = "A" Or oCurrentCell.Value = "B" Or oCurrentCell.Value = "C" Then
      oCurrentCell.EntireRow.Hidden = True
    End If
  Next oCurrentCell

  Application.ScreenUpdating = True
  Exit Sub

errHandler:
    Application.ScreenUpdating = True
End Sub

인터넷에서 해결책을 찾을 수 없어서 구현했습니다.

조건이 있는 Autofilter 코드는 다음과 같습니다.

iColNumber = 1
Dim aFilterValueArray() As Variant
Call ConstructFilterValueArray(aFilterValueArray, iColNumber, Array("A", "B", "C"))

ActiveSheet.range(sRange).AutoFilter Field:=iColNumber _
    , Criteria1:=aFilterValueArray _
    , Operator:=xlFilterValues

실제로 ConstructFilterValueArray() 메서드(함수가 아님)는 특정 컬럼에서 발견된 모든 고유 값을 가져오고 마지막 인수에 있는 모든 값을 삭제합니다.

이 메서드의 VBA 코드는 다음과 같습니다.

'************************************************************
'* ConstructFilterValueArray()
'************************************************************

Sub ConstructFilterValueArray(a() As Variant, iCol As Integer, aRemoveArray As Variant)

    Dim aValue As New Collection
    Call GetDistinctColumnValue(aValue, iCol)
    Call RemoveValueList(aValue, aRemoveArray)
    Call CollectionToArray(a, aValue)

End Sub

'************************************************************
'* GetDistinctColumnValue()
'************************************************************

Sub GetDistinctColumnValue(ByRef aValue As Collection, iCol As Integer)

    Dim sValue As String

    iEmptyValueCount = 0
    iLastRow = ActiveSheet.UsedRange.Rows.Count

    Dim oSheet: Set oSheet = Sheets("X")

    Sheets("Data")
        .range(Cells(1, iCol), Cells(iLastRow, iCol)) _
            .AdvancedFilter Action:=xlFilterCopy _
                          , CopyToRange:=oSheet.range("A1") _
                          , Unique:=True

    iRow = 2
    Do While True
        sValue = Trim(oSheet.Cells(iRow, 1))
        If sValue = "" Then
            If iEmptyValueCount > 0 Then
                Exit Do
            End If
            iEmptyValueCount = iEmptyValueCount + 1
        End If

        aValue.Add sValue
        iRow = iRow + 1
    Loop

End Sub

'************************************************************
'* RemoveValueList()
'************************************************************

Sub RemoveValueList(ByRef aValue As Collection, aRemoveArray As Variant)

    For i = LBound(aRemoveArray) To UBound(aRemoveArray)
        sValue = aRemoveArray(i)
        iMax = aValue.Count
        For j = iMax To 0 Step -1
            If aValue(j) = sValue Then
                aValue.Remove (j)
                Exit For
            End If
        Next j
     Next i

End Sub

'************************************************************
'* CollectionToArray()
'************************************************************

Sub CollectionToArray(a() As Variant, c As Collection)

    iSize = c.Count - 1
    ReDim a(iSize)

    For i = 0 To iSize
        a(i) = c.Item(i + 1)
    Next

End Sub

이 코드는 문자열 배열을 반환할 때 개선될 수 있지만 VBA에서 배열로 작업하는 것은 쉽지 않습니다.

주의: 이 코드는 AdvancedFilter()에서 사용되는 CopyToRange 파라미터에 ExcelRange가 필요하기 때문에 X라는 이름의 시트를 정의하는 경우에만 작동합니다.

microfsoft가 새로운 열거형을 xlNotFilterValues!... 또는 xlRegexMatch로 추가하는 것만으로 이 솔루션을 구현하지 않은 것은 유감입니다.

VBA의 필터 기능을 사용하는 대체 방법

@답변에 대한 으로 @schlebe를 .Filter세 번째 인수를 False로 설정하는 특정 검색 문자열을 필터링할 수 있습니다.모든 "음" 검색 문자열(예: A, B, C)은 배열에 정의됩니다.A열의 기준을 데이터필드 배열로 읽어내고 기본적으로 후속 필터링(A - C)을 실행하여 이러한 항목을 필터링합니다.

코드

Sub FilterOut()
Dim ws  As Worksheet
Dim rng As Range, i As Integer, n As Long, v As Variant
' 1) define strings to be filtered out in array
  Dim a()                    ' declare as array
  a = Array("A", "B", "C")   ' << filter out values
' 2) define your sheetname and range (e.g. criteria in column A)
  Set ws = ThisWorkbook.Worksheets("FilterOut")
  n = ws.Range("A" & ws.Rows.Count).End(xlUp).row
  Set rng = ws.Range("A2:A" & n)
' 3) hide complete range rows temporarily
  rng.EntireRow.Hidden = True
' 4) set range to a variant 2-dim datafield array
  v = rng
' 5) code array items by appending row numbers
  For i = 1 To UBound(v): v(i, 1) = v(i, 1) & "#" & i + 1: Next i
' 6) transform to 1-dim array and FILTER OUT the first search string, e.g. "A"
  v = Filter(Application.Transpose(Application.Index(v, 0, 1)), a(0), False, False)
' 7) filter out each subsequent search string, i.e. "B" and "C"
  For i = 1 To UBound(a): v = Filter(v, a(i), False, False): Next i
' 8) get coded row numbers via split function and unhide valid rows
  For i = LBound(v) To UBound(v)
      ws.Range("A" & Split(v(i) & "#", "#")(1)).EntireRow.Hidden = False
  Next i
End Sub

AutoFilter를 사용하는 옵션

---

Option Explicit

Public Sub FilterOutMultiple()
    Dim ws As Worksheet, filterOut As Variant, toHide As Range

    Set ws = ActiveSheet
    If Application.WorksheetFunction.CountA(ws.Cells) = 0 Then Exit Sub 'Empty sheet

    filterOut = Split("A B C D E F G")

    Application.ScreenUpdating = False
    With ws.UsedRange.Columns("A")
        If ws.FilterMode Then .AutoFilter
       .AutoFilter Field:=1, Criteria1:=filterOut, Operator:=xlFilterValues
        With .SpecialCells(xlCellTypeVisible)
            If .CountLarge > 1 Then Set toHide = .Cells 'Remember unwanted (A, B, and C)
        End With
       .AutoFilter
        If Not toHide Is Nothing Then
            toHide.Rows.Hidden = True                   'Hide unwanted (A, B, and C)
           .Cells(1).Rows.Hidden = False                'Unhide header
        End If
    End With
    Application.ScreenUpdating = True
End Sub

여기에서는, 일정 범위의 리스트를 사용해 필터링 되는 어레이를 채우는 옵션을 나타냅니다.정보가 지워진 후 열이 정렬됩니다.

Sub Filter_Out_Values()

'Automation to remove some codes from the list
Dim ws, ws1 As Worksheet
Dim myArray() As Variant
Dim x, lastrow As Long
Dim cell As Range

Set ws = Worksheets("List")
Set ws1 = Worksheets(8)
lastrow = ws.Cells(Application.Rows.Count, 1).End(xlUp).Row

'Go through the list of codes to exclude
For Each cell In ws.Range("A2:A" & lastrow)

    If cell.Offset(0, 2).Value = "X" Then 'If the Code is associated with "X"
        ReDim Preserve myArray(x) 'Initiate array
        myArray(x) = CStr(cell.Value) 'Populate the array with the code
        x = x + 1 'Increase array capacity
        ReDim Preserve myArray(x) 'Redim array
    End If

Next cell

lastrow = ws1.Cells(Application.Rows.Count, 1).End(xlUp).Row
ws1.Range("C2:C" & lastrow).AutoFilter field:=3, Criteria1:=myArray, Operator:=xlFilterValues
ws1.Range("A2:Z" & lastrow).SpecialCells(xlCellTypeVisible).ClearContents
ws1.Range("A2:Z" & lastrow).AutoFilter field:=3

'Sort columns
lastrow = ws1.Cells(Application.Rows.Count, 1).End(xlUp).Row
'Sort with 2 criteria
With ws1.Range("A1:Z" & lastrow)
    .Resize(lastrow).Sort _
    key1:=ws1.Columns("B"), order1:=xlAscending, DataOption1:=xlSortNormal, _
    key2:=ws1.Columns("D"), order1:=xlAscending, DataOption1:=xlSortNormal, _
    Header:=xlYes, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin
End With

End Sub

이것으로 충분합니다.이것은 2개의 필드/컬럼(9 및 10)에 대한 기준입니다.이 기준에서는 컬럼9에 값이 0보다 큰 행과 컬럼10에 값이 4, 7, 8인 행을 필터링 합니다. lastrow는 data 섹션의 행 수입니다.

ActiveSheet.Range("$A$1:$O$" & lastrow).AutoFilter Field:=9, Criteria1:=">0", Operator:=xlAnd
ActiveSheet.Range("$A$1:$O$" & lastrow).AutoFilter Field:=10, Criteria1:=Arr("4","7","8"), Operator:=xlFilterValues

알았어, 내가 풀었어.

나는 몇 년 동안 이 문제에 대해 여러 번 머리를 부딪혔지만 해결했다.

필터 범위 내에 있는 모든 값을 확인하고 필터링할 값 목록에 없는 경우 "Filter For this item" 목록에 추가합니다.

이 코드에 대해 메모하려면:

• 여러 장에 걸쳐서 작업하기 위해서 쓴 건데, 일이 있어서 시간이 없기 때문에 바꾸지 않을 거예요.네가 알아낼 수 있을 거라고 확신해
• 생각에 는 내 일을 될 것 Option base 1수도 요.그럴 수도 있어요.
• 같은 어레이를 수십만 번 체크하고 재체크를 반복해도 매우 빠릅니다.
• 는 KeepArray츠키노

Option Explicit
Option Base 1
Sub FilterTable()
    
    Dim WS As Worksheet
    Dim L As Long
    Dim I As Long
    Dim N As Long
    Dim tbl As ListObject
    Dim tblName As String
    Dim filterArray
    Dim SrcArray
    Dim KeepArray(1 To 5000) ' you might be able to figure out a way to redim this easiely later on.. for now I'm just oversizing it.

    N = 0
    filterArray = Array("FilterMeOut007", _
                        "FilterMeOut006", _
                        "FilterMeOut005", _
                        "FilterMeOut004", _
                        "FilterMeOut003", _
                        "FilterMeOut002", _
                        "FilterMeOut001")


    For Each WS In ThisWorkbook.Worksheets
        Debug.Print WS.Name
        If Left(WS.Name, 4) = "AR -" Then
            With WS
                tblName = Replace(WS.Name, " ", "_")
                Set tbl = WS.ListObjects(tblName)
                SrcArray = tbl.ListColumns(1).DataBodyRange
                For I = 1 To UBound(SrcArray, 1)
                    If Not ExistsInArray(KeepArray, SrcArray(I, 1)) _
                        And Not ExistsInArray(filterArray, SrcArray(I, 1)) Then
                            N = N + 1
                            KeepArray(N) = SrcArray(I, 1)
                    End If
                Next I
                tbl.DataBodyRange.AutoFilter Field:=1, Criteria1:=KeepArray, Operator:=xlFilterValues
            End With
        End If
    Next WS
End Sub
Function ExistsInArray(arr, Val) As Boolean
    Dim I As Long
    ExistsInArray = False
    For I = LBound(arr) To UBound(arr)
        If arr(I) = Val Then
            ExistsInArray = True
            Exit Function
        End If
    Next I
End Function

향후 가능한 한 휴대할 수 있도록 테스트와 디버깅을 강조하고 싶기 때문에, 에러가 있으면 가르쳐 주세요.자주 사용하는 상상이 됩니다.

범위내의 값을 필터링 하려면 , 이것을 확인해 주세요.그건 효과가 있다.

Selection.AutoFilter field:=33, Criteria1:="<>Array(IN1R,IN2R,INDA)", Operator:=xlFilterValues

사실 위의 코드는 동작하지 않았습니다.따라서 액티브셀에 검색하려는 값이 있을 때마다 행 전체를 숨길 수 있는 루프를 제공합니다.

For each cell in selection
    If cell.value = “IN1R” or cell.value = “INR2” or cell.value = “INDA” then
    Else
        Activecell.Entirerow.Hidden = True
    End if
Next

언급URL : https://stackoverflow.com/questions/28575754/filter-out-multiple-criteria-using-excel-vba