Office TANAKA - Excel VBA Tips[オートフィルタを使い倒す]

大量のデータを絞り込むには、オートフィルタが便利です。ここでは、VBAからオートフィルタを使い倒すテクニックをご紹介します。なお、ボリュームがありますので、以下の項目にページを分けて解説します。

オートフィルタを設定する
オートフィルタの結果を集計する
オートフィルタの結果をコピーする
オートフィルタの結果の特定列だけを操作する　　　　(←このページ)

オートフィルタの結果の特定列だけを操作する

オートフィルタの結果全体をコピーするには

Range("A1").CurrentRegion.Copy

とすればいいです。あるいは、オートフィルタで絞り込んだ結果全体を操作するには

Range("A1").CurrentRegion.SpecialCells(xlTypeVisible)

を使えばいいです。しかし、いずれにしても、これらの操作は、絞り込んだ結果全体が対象になります。ところが実務では、オートフィルタ絞り込んだ結果の、特定の列だけを操作したいときがあります。

たとえば、次のようなリストで考えてみましょう。

このリストに対して、[名前]列を"土屋"で絞り込み、該当する[金額]列(B列)のセルだけ、文字色を赤にします。

まずは、オートフィルタで絞り込むあたりからやってみましょうか。

Sub Sample()
    Range("A1").AutoFilter Field:=1, Criteria1:="土屋"
    Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Select
End Sub

実行すると、次のようになります。

これらのセルを、すべて操作するのは簡単です。

Sub Sample()
    Dim c As Range
    Range("A1").AutoFilter Field:=1, Criteria1:="土屋"
    For Each c In Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)
        c.Font.ColorIndex = 3
    Next c
    Range("A1").AutoFilter
End Sub

絞り込まれた結果の「すべてのセル」ではなく、今回操作したいのは、次の部分です。

この部分だけを操作するには、次の2つの方法が考えられます。簡単な方法と、難しい方法です。

簡単な方法：行と列をチェックする

この操作したいセルとは、絞り込まれた結果のうち

1行目ではないセル
B列のセル

ということです。したがって、For Eachの中で、毎回これらの条件を判定してやればいいです。

Sub Sample()
    Dim c As Range, Target As Range
    Range("A1").AutoFilter Field:=1, Criteria1:="土屋"
    Set Target = Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)
    For Each c In Target
        If c.Row > 1 And c.Column = 2 Then
            c.Font.ColorIndex = 3
        End If
    Next c
    Range("A1").AutoFilter
End Sub

難しい方法：行共有セル範囲の参照を使う

あるいは、前ページで解説した共有セル範囲の参照を使う手もあります。操作の対象になるのは、次のセル範囲です。

上図右上の、セル範囲B2:B9は、次のようにして求めます。

セル範囲B2:B9のうち、先頭のセルB2は、一般的に分かっています。ここを計算などによって求めなければならないようなリストは少ないでしょう。問題は、セルB9です。今回の操作対象がB列なのですから、列がB列というのは確定です。では、行の9は、どう考えればいいのでしょう。これは、オートフィルタの対象範囲である「セル範囲A1:B9」の最終セル「セルB9」と同じ行ということになります。なお、今回のデータでは、最終セル＝セルB9ですが、汎用的に考えるなら、上のようになりますね。

オートフィルタの対象範囲に関しては、前ページで解説していますので、ご覧ください。
ここではコードだけ示します。

Sub Sample()
    Dim A As Range, B As Range, Target As Range
    Range("A1").AutoFilter Field:=1, Criteria1:="土屋"
    With ActiveSheet.AutoFilter
        Set A = Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)
        Set B = Range(Range("B2"), Cells(.Range(.Range.Count).Row, "B"))
    End With
    Set Target = Application.Intersect(A, B)
    Target.Font.ColorIndex = 3
    Range("A1").AutoFilter
End Sub

ここでは、Intersectで求めた共有セル範囲を、変数Targetに格納してから処理しています。文字色を設定するだけでしたら、次のように直接プロパティを指定することも可能です。

Sub Sample()
    Dim A As Range, B As Range
    Range("A1").AutoFilter Field:=1, Criteria1:="土屋"
    With ActiveSheet.AutoFilter
        Set A = Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)
        Set B = Range(Range("B2"), Cells(.Range(.Range.Count).Row, "B"))
    End With
    Application.Intersect(A, B).Font.ColorIndex = 3
    Range("A1").AutoFilter
End Sub

あるいは、行いたい処理が、文字色を変更するよりももっと複雑で、1セルずつ処理しなければいけないのでしたら、次のようにFor Eachを使えばいいでしょう。

Sub Sample()
    Dim A As Range, B As Range, c As Range
    Range("A1").AutoFilter Field:=1, Criteria1:="土屋"
    With ActiveSheet.AutoFilter
        Set A = Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)
        Set B = Range(Range("B2"), Cells(.Range(.Range.Count).Row, "B"))
    End With
    For Each c In Application.Intersect(A, B)
        c.Font.ColorIndex = 3
    Next c
    Range("A1").AutoFilter
End Sub

まぁ、特別な事情がなければ、こんな難しいことをしないで、簡単な方法を使えばいいでしょう。ちなみに、この難しい"共有セル範囲の参照"を使うのであれば、少なくとも上のコードを見て「ふむふむ、なるほどね」と余裕で読めるくらいのスキルが必要です。何が書いてあるか分からないのに、コピペで何とかなるような考え方ではありません。

絞り込んだ結果のセルに何か代入する

では、次のような処理を考えてみましょう。

こうした処理も、実務ではよくありますね。
これは簡単です。上記の「該当するB列だけ文字色を赤色にする」と同じ考え方でできます。

Sub Sample()
    Dim c As Range
    Range("A1").AutoFilter Field:=1, Criteria1:="土屋"
    For Each c In Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)
        If c.Column = 3 And c.Row > 1 Then
            c = "○"
        End If
    Next c
    Range("A1").AutoFilter
End Sub

では、次のように「C列にタイトルがなかったら」どうでしょう。

こうしたリストにオートフィルタを設定すると、当然ながら、オートフィルタの対象範囲はA列とB列だけになります。C列は範囲に含まれません。

つまり、絞り込んだ結果を表す「Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)」にC列のセルは含まれていませんので、上記コードのように、条件判定で「If c.Column = 3 And c.Row > 1 Then」と、"C列かどうか"を判定しても、該当するセルは見つかりません。そんなときは、お隣B列のセルを使ってやります。

Sub Sample()
    Dim c As Range
    Range("A1").AutoFilter Field:=1, Criteria1:="土屋"
    For Each c In Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)
        If c.Column = 2 And c.Row > 1 Then
            c.Offset(0, 1) = "○"
        End If
    Next c
    Range("A1").AutoFilter
End Sub

次は、もう少し変えてみましょう。今度は"○"を代入するのではなく、セルの数値を計算します。

リストを"土屋"で絞り込んで、該当する行だけ「合計」を計算するには、次のようにします。

Sub Sample()
    Dim c As Range
    Range("A1").AutoFilter Field:=1, Criteria1:="土屋"
    For Each c In Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)
        If c.Column = 4 And c.Row > 1 Then
            c = c.Offset(0, -1) + c.Offset(0, -2)
        End If
    Next c
    Range("A1").AutoFilter
End Sub

ここでもOffsetが大活躍ですね。
計算結果の値を直接代入するのではなく、数式を代入するのなら、次のような感じです。

Sub Sample()
    Dim c As Range
    Range("A1").AutoFilter Field:=1, Criteria1:="土屋"
    For Each c In Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)
        If c.Column = 4 And c.Row > 1 Then
            c = "=" & c.Offset(0, -1).Address(False, False) & "+" & _
                      c.Offset(0, -2).Address(False, False)
        End If
    Next c
    Range("A1").AutoFilter
End Sub

くれぐれも

c = "=B" & c.Row & "+C" & c.Row

などという下品なやり方はしないでくださいね。

このように、オートフィルタで絞り込んだ特定の列だけ操作するには、絞り込まれた結果のセル範囲「Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)」内のセルを1つずつ調べるのが簡単です。やってることはベタですけど、速度的な心配はいりません。あなたが"あえて"遅い書き方をしない限り、VBAは高速ですから。

ついでですから、UserFormとの合わせ技もご紹介しましょうか。

上のようなリストがあって、

このようなUserFormから、任意の名前で絞り込みます。ついでに、ListBoxの番号をクリックしたら、該当する「金額」をLabelに表示してみましょう。

Private Sub CommandButton1_Click()
    Dim c As Range
    If ComboBox1.Text = "" Then Exit Sub
    ListBox1.Clear
    Range("A1").AutoFilter Field:=2, Criteria1:=ComboBox1.Text
    For Each c In Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)
        If c.Column = 1 And c.Row > 1 Then
            ListBox1.AddItem c
        End If
    Next c
    Range("A1").AutoFilter
    Label1.Caption = ""
End Sub

Private Sub ListBox1_Click()
    Dim FoundCell As Range
    Set FoundCell = Range("A:A").Find(What:=ListBox1.Text, Lookat:=xlWhole)
    Label1.Caption = FoundCell.Offset(0, 2)
End Sub

Private Sub UserForm_Initialize()
    With ComboBox1
        .AddItem "田中"
        .AddItem "鈴木"
        .AddItem "土屋"
        .AddItem "佐藤"
    End With
End Sub

こんな感じです。

オートフィルタは、Excelに用意された強力な武器のひとつです。手動で操作するときはもちろん、マクロから操作することで、実にさまざまな処理が可能になります。たとえば、下図のようなリストで、A列から"田中"を探すには(いろいろな方法がありますけど)次のようにします。

Sub Sample()
    Dim FoundCell As Range
    Set FoundCell = Range("A:A").Find(What:="田中", Lookat:=xlWhole)
    If Not FoundCell Is Nothing Then
        MsgBox "田中は" & vbCrLf & FoundCell.Offset(0, 1) & vbCrLf & FoundCell.Offset(0, 2)
    End If
End Sub

しかし、実務は教科書のように単純ではありません。探したい"田中"が複数あって(あるかもしれなくて)、その中で最も新しい日付の金額を調べたい。そんなことは、よくあります。ちなみに、上記コードのFindを使って、すべての項目を検索することも可能ですが、決して簡単ではありません。その方法は、下記ページをご覧ください。

すべて検索する

しかし、そんなときでも、オートフィルタを使えば簡単に解決できる場合があります。次のコードは、A列の"田中"のうち、B列の日付が最新の「金額」を表示します。

Sub Sample()
    Dim c As Range, LastDate As Date, MAX As Long
    Range("A1").AutoFilter Field:=1, Criteria1:="田中"
    For Each c In Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)
        If c.Column = 2 And c.Row > 1 Then
            If LastDate < c.Value Then
                LastDate = c.Value
                MAX = c.Offset(0, 1)
            End If
        End If
    Next c
    Range("A1").AutoFilter
    MsgBox "最新は" & vbCrLf & LastDate & vbCrLf & MAX
End Sub

あるいは、次のようなケースもあるでしょう。下図リストの"田中"、"鈴木"、"山田"の、最新レコード(行)だけを、別の場所(ここではE列～G列)にコピーしたいと。

Sub Sample()
    Dim c As Range, LastDate As Date
    Dim i As Long, Target As Range, Member As Variant
    Member = Array("田中", "鈴木", "山田")
    For i = 0 To UBound(Member)
        Range("A1").AutoFilter Field:=1, Criteria1:=Member(i)
        LastDate = 0
        Set Target = Nothing
        For Each c In Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)
            If c.Column = 2 And c.Row > 1 Then
                If LastDate < c.Value Then
                    LastDate = c.Value
                    Set Target = Range(c.Offset(0, -1), c.Offset(0, 1))
                End If
            End If
        Next c
        Target.Copy Cells(i + 2, "E")
    Next i
    Range("A1").AutoFilter
End Sub