データ抽出用クラスを作る

データ抽出用のクラス

AdvancedFilterメソッドを気軽に使う

あんまり役に立たないと思うけど、ちょっと作ってみた。

準備として、

データ抽出元のシートを用意。

こんなふうに抽出条件設定用の表を作り、

セル範囲に名前を付けておく。

ちなみに、抽出条件は、ヨコの並びがAND、タテの並びがOR条件。

この画像だと、「戦法が先捲か捲先で、80期未満の選手」を抽出することになる。

競輪を例にしているだけに、タテだのヨコだの言ったらややこしいな。

抽出先のデータラベルもこのように準備。同じく、名前を付けておく。

クラスモジュールのコード

クラスモジュールを挿入して、オブジェクト名は「DataExtractor」にした。

リスト1-1　フィールド・アクセサ部分

Option Explicit
'Fields;Module Level Variables'
Private dataSource_ As Range    '……(1)'
Private rangeOfCriteria_ As Range
Private copyTo_ As Range
'Accessor;Properties'
Public Property Get extractedRange() As Range    '……(2)'
  Set extractedRange = copyTo_.CurrentRegion
End Property

Public Property Get dataCount() As Long
  dataCount = extractedRange.Rows.Count - 1
End Property

珍しく、仮変数とPropertyプロシージャの名前（？）が一致していない。

(1)からの３行、

Private dataSource_ As Range
Private rangeOfCriteria_ As Range
Private copyTo_ As Range

は、AdvancedFilterメソッドの実行に必要なオブジェクトや引数。

従って、メソッド実行時に引数として渡せば良いし、後で取得することもないだろうから、変数のみにした。

逆に、(2)からの６行、

Public Property Get extractedRange() As Range
  Set extractedRange = copyTo_.CurrentRegion    '……(a)'
End Property
Public Property Get dataCount() As Long
  dataCount = extractedRange.Rows.Count - 1    '……(b)'
End Property

は、抽出実行後に自ずと決まるものなので、仮変数は必要ないと思った。

(a)は、抽出先のセルのCurrentRegionプロパティを取得することで、抽出されたデータ範囲をセットしている。

(b)は、(a)で決まった抽出データの範囲の行数を取得し、１を引くことで、抽出されたデータの件数をセットしている。

リスト1-2　メソッド部分

Public Sub extractData(ByVal dataSource As Range, _
                       ByVal rangeOfCriteria As Range, _
                       ByVal copyTo As Range)    '……(1)'
  Set dataSource_ = dataSource    '……(2)'
  Set rangeOfCriteria_ = rangeOfCriteria
  Set copyTo_ = copyTo
  copyTo_.CurrentRegion.Offset(1, 0).Clear    '……(3)'
  dataSource_.AdvancedFilter _
                Action:=xlFilterCopy, _
                criteriaRange:=rangeOfCriteria_, _
                CopytoRange:=copyTo_    '……(4)'
  extractedRange _
    .Offset(1, 0) _
    .Borders.LineStyle = xlNone    '……(5)'
End Sub

メソッドはとりあえず一つだけ。

(1)の

Public Sub extractData(ByVal dataSource As Range, _
                       ByVal rangeOfCriteria As Range, _
                       ByVal copyTo As Range)

でお分かりのように、３つの引数を受け取って実行する。

• 第１引数は抽出元のデータ範囲
• 第２引数は抽出条件のデータ範囲
• 第３引数は抽出先のデータラベルの範囲

それぞれの引数の役割は以上の通り。

(2)からの３行、

Set dataSource_ = dataSource
Set rangeOfCriteria_ = rangeOfCriteria
Set copyTo_ = copyTo

は、引数をクラス内の仮変数に代入している。

(3)の

copyTo_.CurrentRegion.Offset(1, 0).Clear

によって、一旦抽出先の表をクリア。データラベルを消さないようにOffsetしている。

(4)の

dataSource_.AdvancedFilter _
              Action:=xlFilterCopy, _
              CriteriaRange:=rangeOfCriteria_, _
              CopytoRange:=copyTo_

これがAdvancedFilterメソッドの本体。これで抽出が行われる。

あと、(5)の

extractedRange _
    .Offset(1, 0) _
    .Borders.LineStyle = xlNone

は、抽出されたデータ範囲の罫線消去。

別になくても困らないとは思うけど、罫線が残ったままだとブサイクなのでこうした。

DataExtractorクラスを使う

宣言セクションにEnumを追加する。

リスト2-1　標準モジュールの宣言セクション

Public Enum extractCol
  rcName = 1
  rcPhonetic
  belongsTo
  graduateTerm
  rcGrade
  rcClass
  rcStyle
  isEliminated
End Enum

リスト2-2　実行用コード

Public Sub test03()
  With ThisWorkbook
    Set orgSh = ThisWorkbook.Worksheets("選手データ")
    Set extractSh = ThisWorkbook.Worksheets("抽出")
  End With
  Dim dtExtractor As DataExtractor    '……(1)'
  Set dtExtractor = New DataExtractor
  With dtExtractor    '……(2)'
    .extractData orgSh.Range("A1").CurrentRegion, _
                 Range("RangeOfCriteria"), _
                 Range("CopyToRange")    '……(3)'
    MsgBox "全 " & .dataCount & " 名、抽出完了。", vbInformation
    Dim str As String
    str = "抽出したのは、" & vbCrLf & vbCrLf
    If .dataCount = 0 Then
      MsgBox str & "……て、誰もおらんやないかーーーーい！", vbCritical
      Exit Sub
    End If
    Dim i As Integer
    Dim flg As Boolean
    For i = 1 To .dataCount
      If i > 5 Then
        flg = True
        Exit For
      End If
      str = str & extractSh.Cells(i + 1, extractCol.rcName).Value _
            & "選手、" & vbCrLf
    Next
  End With
  str = Left(str, Len(str) - 1)
  If flg = True Then
    str = str & vbCrLf & "……て、人数多すぎるんじゃぼけーーー！" & _
            vbCrLf & "やってられっか！"
    MsgBox str
    Exit Sub
  End If
  MsgBox str & "です。"
End Sub

(1)からの２行、

Dim dtExtractor As DataExtractor
Set dtExtractor = New DataExtractor

は、インスタンス用の変数の宣言とNewによるインスタンス化。

(2)の

With dtExtractor

は、おなじみの記述。

(3)で抽出実行。セル範囲に名前を付けているので、簡単に指定できる。

以下のコードは単なるギミック。よって説明は省略。

実行結果

このコードを実行すると、

無事抽出処理ができた。

このままだと、まあ直接AdvancedFilterメソッド使った方が楽なので、改良が必要かな。