とある総務の備忘録

ただの備忘録です。PC,Excelの使い方等。覚えた事をすぐに忘れるのでBlogで記録している。

複数のシートで一気にオートフィルタをするマクロ

複数のシートで同じ書式で似たような情報が入っている時、

一気にオートフィルタの絞り込みをするためのマクロを組んでみました。

 

f:id:ninappe:20200711233122j:plain

f:id:ninappe:20200711233125j:plain

f:id:ninappe:20200711233128j:plain

こんな感じで年次毎のデータがあったとします。

(分かりやすいように色を変えただけで内容は一緒です)

 

f:id:ninappe:20200711233138j:plain

商品名の一覧を別シートに作っておきます。

 

f:id:ninappe:20200711233144j:plain

こんな感じのユーザーフォームを呼び出して、

 

f:id:ninappe:20200711233148j:plain

コンボボックスに商品名をプルダウンさせます。

 

f:id:ninappe:20200711233152j:plain

f:id:ninappe:20200711233211j:plain

f:id:ninappe:20200711233214j:plain

全部のシートでフィルタできました。

データがいっぱいある時なら使えるかもね。

 




コードはこちら

 

Module1に書くコード

 

Sub Openform()

UserForm1.Show

End Sub

 

 

 

UserForm1に書くコード

 

キャンセルボタンで終了するマクロ

 

Private Sub CommandButton2_Click()
Unload UserForm1
End Sub

 

-----------------------------------------------------

 

コンボボックスに商品一覧を呼び出すマクロ


Private Sub UserForm_Initialize()

Dim 最終行 As Integer
Dim i As Integer
最終行 = Worksheets("商品一覧").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To 最終行
ComboBox1.AddItem Worksheets("商品一覧").Range("A" & i).Value
Next i

End Sub

 

-----------------------------------------------------

 

決定を押したら↓のプロシージャ「フィルタ」を呼び出すマクロ


Private Sub CommandButton1_Click()
Call フィルタ
End Sub

 

-----------------------------------------------------

 

指定したシートで繰り返すマクロ


Private Sub フィルタ()

Application.ScreenUpdating = False

Dim 商品名 As Variant
Dim WS As Long
商品名 = ComboBox1.Text

For WS = 1 To 3
Sheets(WS).Activate

 

-----------------------------------------------------

 

コンボボックスのデータでフィルタの絞り込みをするマクロ


With ActiveSheet
If .FilterMode Then .ShowAllData
.Range("A1").AutoFilter Field:=1, _
Criteria1:=商品名
End With

Next WS

Application.ScreenUpdating = True

Sheets("2017年").Activate
Unload UserForm1

End Sub

 

-----------------------------------------------------

なんかすごい数になっちゃった。

 

f:id:ninappe:20200711233435j:plain

プルダウンリストが見づらかったらここで行数を増やすといいよ。

 

 

フィルタリングしたら解除するマクロも入れた方が良いです。

全てのシートのオートフィルタを解除せずに全行を表示 - とある総務の備忘録