オートフィルタの設定範囲から任意の列のデータ部のRangeを取得するVBA関数

今回はオートフィルタの設定範囲から任意の列のデータ部のRangeを取得するVBA関数を作ったので紹介します。

---

目的

現在作成中のツールの基盤となる関数の下準備です。

今回のサンプルでは下図のような動作をします。

コード

Const COL1 = "連番"

'オートフィルタの設定範囲から任意の項目名の列のデータ部のRangeを取得
'存在しない列の場合は右端の空の列に追加する。
Function AddColDataRange(WS As Worksheet, ColumnName As String) As Range
    Dim tbl As Range
    Dim rng As Range
    Dim ret As Range
    
    'ColumnName列を検索し、データ部のみを返却対象とする
    On Error Resume Next
    Set tbl = WS.AutoFilter.Range
    On Error GoTo 0
    If tbl Is Nothing Then
        Err.Raise 9999, "AddColDataRange", "オートフィルタ未設定のシートでの実行は認めない"
    End If
    
    '列を検索して存在したらデータ部を返す
    For Each rng In tbl.Resize(1)
        If rng.Value = ColumnName Then
            Set ret = rng.Offset(1).Resize(tbl.Rows.Count - 1)
            Exit For
        End If
    Next
    
    '存在しない時は列を追加してからデータ部を返す
    If ret Is Nothing Then
        '列を追加するために空の列を検索
        '※空欄列が有り得る為、逆順探索する。
        Dim i As Long
        For i = tbl.Columns.Count To 1 Step -1
            If WorksheetFunction.CountA(tbl.Offset(, i).Resize(, 1)) = 0 Then Exit For
        Next
        '列名の記入／オートフィルタの更新／戻り値の設定
        tbl(1, i + 1).Value = ColumnName
        Set ret = tbl.Offset(1).Offset(, i).Resize(tbl.Rows.Count - 1, 1)
        tbl.AutoFilter
        tbl.Resize(, tbl.Columns.Count + 1).AutoFilter
    End If
    
    Set AddColDataRange = ret
End Function

Sub ①連番を出力()
    With AddColDataRange(ActiveWindow.ActiveSheet, COL1)
        .Item(1).Value = 1
        .Item(1).AutoFill Destination:=.Cells, Type:=xlLinearTrend
        '.Select
    End With
End Sub

解説

AddColDataRange関数は、オートフィルタが設定された領域に任意の項目が無ければ追加し、データ部のRangeを返す関数です。

取得関数とは謳っていますが、「列の追加」が主目的でそのついでに「列データ部のRangeを返す」ようにしているため、名称をAdd～としています。

今回は単純に連番を記入するだけですが、今後の記事で増えていく予定です。

特定用途用の関数なので列の追加とデータ部の取得を一度に行っていますが、本当なら分割したほうが良いかもしれません。（でもこの方が便利な場面が多い気がする）

簡単ですが、とりあえず本日は以上です。

以上

---

何か御座いましたらコメント欄、またはTwitterからどうぞ♪

それではまた来週♪　ちゅんちゅん(・8・)