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

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

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Q&A

解決済

2回答

4823閲覧

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

qqkf

総合スコア10

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

0グッド

0クリップ

投稿2020/10/08 14:22

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

■現状
・コードを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

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

kitasue

2020/10/09 04:55

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

回答2

0

ベストアンサー

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メソッドが失敗しました。」と言うエラーメッセージが出たみたいですね。 解決できました。
guest

0

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

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

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

投稿2020/10/08 14:34

kuma_kuma_

総合スコア2506

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

qqkf

2020/10/09 12:44

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

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

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

ただいまの回答率
85.50%

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

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

質問する

関連した質問