【Excel VBA】オートフィルタで抽出された範囲のコピー

実務で Excel VBA を使っていると、ある条件でオートフィルタをかけ、そこで抽出されたデータだけを別のシート等にコピーしたい、ということが結構ある。（当然、オートフィルタをかける対象の1行目はタイトル行（Accessで言えばフィールド名）である。）その場合、フィルタ後の最終行の取得は、タイトル行のセルから Range(“A1”).End(xlDown).row() とやれば取得できるので悩む必要はないが、フィルタ後の最初の行（←タイトル行は除いた場合の1行目）は一手間かけないと取得できない。

ということで作成したのが、以下のユーザー定義関数 FirstDisplayedRow だ。

仕組みとしては、オートフィルタ対象のセル範囲の中の任意の列を基準としてセル範囲の上から検索していき、一番最初の、表示されているセルの行番号を返す、という風になっている。

また、ついでではあるが、セットで使える関数として、フィルタ後の（表示されている）最終行を取得する関数（ LastDisplayedRow ）も作成した。

この二つの関数を使って、例えば、オートフィルタで抽出した範囲をコピーし、別のシートに貼り付けるコードは、以下のサンプルプログラムのように書ける。

このサンプルプログラムは、Sheet1 のB2～K100 にオートフィルタを掛けたデータを入れておき、その中で、E列が「ETF・ETN」のものを抽出して、Sheet2のB3セルに貼り付けるというものだ。

（なお、タイトル行は別途転記しないといけないので注意。というのも、実務では、毎月とか4半期ごとに同じ作業をやって、Excelの同じ場所に、毎回同じようなデータを貼り付けるということが多いと思うが、その場合、タイトル行は既に記入されているので、毎回転記する必要がないからだ。）

 

Option Explicit

'==============================================================================
'シート「Sheet1」 のB2～K100 にオートフィルタを掛けたデータが入っており、
'その中で、E列が「ETF・ETN」のものを抽出して、シート「Sheet2」のB3セルに貼り付ける。
'（元データは東証のサイトからDLしたもの）
'
'シート「Sheet1」をアクティブにしてから実行すること。
'==============================================================================

Public Sub sample()

    Dim firstRow As Long, lastRow As Long
    Dim rngCriteriaColumn As Range
    
    Set rngCriteriaColumn = Range("E3:E100")    'ETF・ETN等の情報が入っているのはE列
    
    If ActiveSheet.AutoFilter.FilterMode Then
        '既に一部のデータが抽出された状態になっている場合は、全てのデータを表示する（そのまま終了）。
        ActiveSheet.ShowAllData
    Else
        'セルB2 を起点とした、AutoFilter のかかった Range 範囲について、
        '4番目のフィールド（E列）のデータが "ETF・ETN" である行を抽出する
        ActiveSheet.Range("$B$2").AutoFilter field:=4, Criteria1:="ETF・ETN"
        firstRow = FirstDisplayedRow(rngCriteriaColumn)     '表示されている最初の行を取得
        lastRow = LastDisplayedRow(rngCriteriaColumn)      '表示されている最後の行を取得
        ActiveSheet.Range("B" & firstRow & ":K" & lastRow).Copy Worksheets("Sheet2").Range("B3")
    End If
End Sub

'==============================================================================
'AutoFilter をかけている時に表示されている1行目の行番号（タイトル行を除く）を返す関数
'【注】タイトル行は除いた Range を渡すこと
'==============================================================================
Public Function FirstDisplayedRow(ByVal tmpRange As Range) As Long
    Dim tmpCell As Range
    For Each tmpCell In tmpRange
        If tmpCell.EntireRow.Hidden = False Then
            FirstDisplayedRow = tmpCell.Row()
            Exit Function
        End If
    Next tmpCell
End Function


'==============================================================================
'最終行を返す関数（AutoFilterをかけている場合は、表示されている最終行を返す）
'【注】Shift + ↓と同じ動きをした場合の行番号を返す
'==============================================================================
Public Function LastDisplayedRow(ByVal tmpRange As Range) As Long
    LastDisplayedRow = tmpRange.End(xlDown).Row()
End Function

 

↓Excelのワークシートはこんな感じ。（元データは東証のサイトから取得。）