VBA 複数列にフィルターをつけ絞り込みたい

■実現したいこと
・複数列をフィルターで付けた後、チェック入れたものだけで絞り込みたいです。

■現状
・コードを2つ書いたのですが、どちらも上手くいかないです。
1つ目のコードは、複数列をフィルターを付けたのですが、
両方にフィルターがかかった状態になります。
どちらか一方にチェックをした場合だと表示ができないです。
2つ目のコードは、1つ目のコードと逆です。両方にチェックを入れると
「RangeクラスのAutoFilterメソッドが失敗しました。」と言うエラーメッセージが
でたのですが、調べてフィルター解除してから再度フィルターを付けたのですが
それでも同じエラーメッセージがでました。

■分からないこと
・複数列に対してどうやってフィルターを付けどうやって絞り込んでいるのか分からないです。

画像が以下になります。

画像1
これは、実行画面です。
手順③と④にチェックボックスを付けチェックを入れたものに対し、比較します。
比較後は、35行目に表示されます。

画像2
[順位付け]シートで比較を行っています。
種類一覧(H列)とメーカー一覧(I列)にフィルターつけたプログラムを作成したのですが、
絞り込みが上手にできない。

コードが以下になります。
1つ目のコード

VBA
1Private Sub HikakuButton_Click()
2    Dim wbk As Workbook         '比較一覧表ファイル
3    Dim wshCmp As Worksheet     '自動比較ツール:[データ比較]シート
4    Dim wshOrd As Worksheet     '自動比較ツール:[順位付け]シート
5    Dim i As Long
6
7    Set wshCmp = Worksheets("データ比較")
8    Set wshOrd = Worksheets("順位付け")
9
10    Set wbk = Workbooks.Open(wshCmp.Range("C13").Value, ReadOnly:=True) '読み取り専用で開く
11    
12    For i = 1 To 3
13        wbk.Worksheets(i & "_比較一覧").Range("A4:I8").Copy wshOrd.Range("A" & i * 5 - 2)
14    Next i
15    
16    wbk.Close SaveChanges:=False: Set wbk = Nothing
17
18    wshOrd.Range("B2").Value = wshCmp.Range("C6")  'A Sample
19    wshOrd.Range("C2").Value = wshCmp.Range("E6")  'B Sample
20    wshOrd.Range("D2").Value = wshCmp.Range("G6")  'C Sample
21    wshOrd.Range("E2").Value = wshCmp.Range("C7")  'D Sample
22    wshOrd.Range("F2").Value = wshCmp.Range("E7")  'E Sample
23    wshOrd.Range("G2").Value = wshCmp.Range("G7")  'F Sample
24
25    wshOrd.Range("A1").AutoFilter
26
27    With wshOrd.Sort
28        .SortFields.Clear
29        .SortFields.Add Key:=Range("V3:V17")
30        .SetRange Range("A3:V17")
31        .Apply
32    End With
33    
34    'チェックボックスにチェック入れたものに対して、フィルターを行う
35    '1つ目のコード
36    'これだと、片方だけチェック入れてもフィルターができないです
37    Dim strCriteria() As String
38    Dim strCriteria2() As String
39    Dim j As Long
40
41    j = -1
42
43    For i = 1 To 7
44        If wshCmp.CheckBoxes("CheckBox" & i).Value = xlOn Then
45            j = j + 1
46            ReDim Preserve strCriteria(j)  '動的配列宣言
47            ReDim Preserve strCriteria2(j) '動的配列宣言
48            strCriteria(j) = wshCmp.CheckBoxes("CheckBox" & i).Caption
49            strCriteria2(j) = wshCmp.CheckBoxes("CheckBox" & i).Caption
50        End If
51    Next i
52
53    If j >= 0 Then
54        With wshOrd.Range("A2:I17")
55            .AutoFilter Field:=8, Criteria1:=strCriteria, Operator:=xlFilterValues
56            .AutoFilter Field:=9, Criteria1:=strCriteria2, Operator:=xlFilterValues
57        End With
58    End If
59        
60    'チェックボックスにチェック入れた後、入れたものに対して[データ比較]シートに貼り付け及びセルクリア
61    wshOrd.Range("A80:I100").ClearContents
62    wshOrd.Range("A1").CurrentRegion.Resize(, 9).Copy wshOrd.Range("A81")
63    wshCmp.Range("A35:I41").Value = wshOrd.Range("A83:I89").Value
64    wshOrd.Range("A80:I100").ClearContents
65    wshOrd.Range("A80:I100").ClearFormats
66
67    Set wshOrd = Nothing
68    Set wshCmp = Nothing
69
70End Sub

2つ目のコード

VBA
1Private Sub HikakuButton_Click()
2    Dim wbk As Workbook         '比較一覧表ファイル
3    Dim wshCmp As Worksheet     '自動比較ツール:[データ比較]シート
4    Dim wshOrd As Worksheet     '自動比較ツール:[順位付け]シート
5    Dim i As Long
6
7    Set wshCmp = Worksheets("データ比較")
8    Set wshOrd = Worksheets("順位付け")
9
10    Set wbk = Workbooks.Open(wshCmp.Range("C13").Value, ReadOnly:=True) '読み取り専用で開く
11    
12    For i = 1 To 3
13        wbk.Worksheets(i & "_比較一覧").Range("A4:I8").Copy wshOrd.Range("A" & i * 5 - 2)
14    Next i
15    
16    wbk.Close SaveChanges:=False: Set wbk = Nothing
17
18    wshOrd.Range("B2").Value = wshCmp.Range("C6")  'A Sample
19    wshOrd.Range("C2").Value = wshCmp.Range("E6")  'B Sample
20    wshOrd.Range("D2").Value = wshCmp.Range("G6")  'C Sample
21    wshOrd.Range("E2").Value = wshCmp.Range("C7")  'D Sample
22    wshOrd.Range("F2").Value = wshCmp.Range("E7")  'E Sample
23    wshOrd.Range("G2").Value = wshCmp.Range("G7")  'F Sample
24
25    wshOrd.Range("A1").AutoFilter
26
27    With wshOrd.Sort
28        .SortFields.Clear
29        .SortFields.Add Key:=Range("V3:V17")
30        .SetRange Range("A3:V17")
31        .Apply
32    End With
33    
34    'チェックボックスにチェック入れたものに対して、フィルターを行う
35    '2つ目のコード
36    'メーカー一覧のチェックボックス名を変えたのですが、片方のみできたのですが、
37    '両方にチェックを入れた場合できないです。
38    Dim strCriteria() As String
39    Dim strCriteria2() As String
40    Dim j As Long
41    Dim k As Long
42
43    j = -1
44    k = -1
45
46    For i = 1 To 4
47        If wshCmp.CheckBoxes("CheckBox" & i).Value = xlOn Then
48            j = j + 1
49            ReDim Preserve strCriteria(j)  '動的配列宣言
50            strCriteria(j) = wshCmp.CheckBoxes("CheckBox" & i).Caption
51        End If
52    Next i
53
54    For i = 1 To 3
55        If wshCmp.CheckBoxes("CheckBox2_" & i).Value = xlOn Then
56            k = k + 1
57            ReDim Preserve strCriteria2(k)  '動的配列宣言
58            strCriteria2(k) = wshCmp.CheckBoxes("CheckBox2_" & i).Caption
59        End If
60    Next i
61
62    If j >= 0 Then
63        With wshOrd.Range("A2:H17")
64            .AutoFilter Field:=8, Criteria1:=strCriteria, Operator:=xlFilterValues
65        End With
66    End If
67
68    If k >= 0 Then
69        With wshOrd.Range("A2:I17")
70            .AutoFilter Field:=9, Criteria1:=strCriteria2, Operator:=xlFilterValues
71        End With
72    End If
73    
74    If wshOrd.AutoFilter.FilterMode = True Then
75        wshOrd.Range("A1").AutoFilter
76    End If
77    
78    'チェックボックスにチェック入れた後、入れたものに対して[データ比較]シートに貼り付け及びセルクリア
79    wshOrd.Range("A80:I100").ClearContents
80    wshOrd.Range("A1").CurrentRegion.Resize(, 9).Copy wshOrd.Range("A81")
81    wshCmp.Range("A35:I41").Value = wshOrd.Range("A83:I89").Value
82    wshOrd.Range("A80:I100").ClearContents
83    wshOrd.Range("A80:I100").ClearFormats
84
85    Set wshOrd = Nothing
86    Set wshCmp = Nothing
87
88End Sub

kitasue

2020/10/09 04:55

> 「RangeクラスのAutoFilterメソッドが失敗しました。」と言うエラーメッセージがこのエラーはどの行で出ましたか？

行動規範の内容に同意します

回答2件

ベストアンサー

2つ目のコードでいけそうな気がしますが、ただ、後ろの方の、

VBA
1    If wshOrd.AutoFilter.FilterMode = True Then
2        wshOrd.Range("A1").AutoFilter
3    End If

は、不要だと思います。

追加です。

VBA
1        With wshOrd.Range("A2:H17")
2            .AutoFilter Field:=8, Criteria1:=strCriteria, Operator:=xlFilterValues

は、

VBA
1        With wshOrd.Range("A2:I17")
2            .AutoFilter Field:=8, Criteria1:=strCriteria, Operator:=xlFilterValues

では。

投稿2020/10/09 03:50

編集2020/10/09 11:36

kitasue

総合スコア314

qqkf

2020/10/09 12:42

回答ありがとうございます。種類一覧のセル選択の仕方が悪かったんですね。それでメーカー一覧ところで上書き？されて「RangeクラスのAutoFilterメソッドが失敗しました。」と言うエラーメッセージが出たみたいですね。解決できました。

行動規範の内容に同意します

Excel VBA オートフィルターで複数条件で絞り込みする方法

2.複数列を文字列で絞り込み

※もうここまでできるようになっているなら自分で調べて完成させることができると思いますよ。

投稿2020/10/08 14:34

kuma_kuma_

総合スコア2506

qqkf

2020/10/09 12:44

参考リンクありがとうございます。 2つ目のコードでセルの選択が悪かったです。

行動規範の内容に同意します

あなたの回答

tips

プレビュー

行動規範の内容に同意します

質問の解決につながる回答をしましょう。サンプルコードなど、より具体的な説明があると質問者の理解の助けになります。また、読む側のことを考えた、分かりやすい文章を心がけましょう。

15分調べてもわからないことは
teratailで質問しよう！

ただいまの回答率
85.35%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう！

VBA 複数列にフィルターをつけ絞り込みたい

関連した質問