web-dev-qa-db-ja.com

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範囲クラスのオートフィルターメソッドが失敗しました

これをどのように実行できますか？

excelvbaexcel-vbaexcel-2010excel-2007
12
user4577989

私は（実験から-MSDNはここでは役に立たない）これを行う直接的な方法はないと思います。 _Criteria1_をArrayに設定することは、ドロップダウンでチェックボックスを使用することと同等です-あなたが言うように、それは配列内の項目のいずれかに一致する項目に基づいてリストをフィルタリングします。

興味深いことに、リストにリテラル値_"<>A"_および_"<>B"_があり、これらのフィルターを適用すると、マクロレコーダーが思い付きます。

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

動作します。しかし、その後、リテラル値_"<>C"_があり、マクロの記録中に3つすべて（ティックボックスを使用）でフィルターすると、マクロレコーダーはコードを正確に複製し、エラーで失敗します。私はそれをバグと呼ぶと思います-VBAではできないUIを使用して実行できるフィルターがあります。

とにかく、問題に戻りましょう。いくつかの基準に等しくない値をフィルタリングすることは可能ですが、最大2つの値しか使用できません。

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

正確な問題に応じて可能な回避策がいくつかあります。

  1. 列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
_
17
aucuparia

インターネット上で解決策を見つけていないので、実装しました。

条件付きのオートフィルターコードは

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パラメーターがExcel範囲を必要とするため、Xという名前のシートを定義する場合にのみ機能します。

Microfsoftが新しい列挙型をxlNotFilterValuesとして追加するだけでこのソリューションを実装していないのは残念です！ ...またはxlRegexMatch！

0
schlebe

オートフィルターを使用するオプション

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
0
paul bica

ここでは、ある範囲に書き込まれたリストを使用するオプションがあり、フィルターされる配列にデータが入力されます。情報が消去され、列がソートされます。

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
0
Ogier

VBAのフィルター機能を使用した代替

@schlebeの最近の答えに対する革新的な代替手段として、[〜＃〜] vba [〜＃〜]に統合されたFilter関数を使用しようとしました。 filter out 3番目の引数をFalseに設定する特定の検索文字列。すべての "negative"検索文字列（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
0
T.M.