読者です 読者をやめる 読者になる 読者になる

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

データ抽出用のクラス

AdvancedFilterメソッドを気軽に使う

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

準備として、

f:id:akashi_keirin:20170416102826j:plain

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

f:id:akashi_keirin:20170416102837j:plain

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

f:id:akashi_keirin:20170416102833j:plain

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

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

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

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

f:id:akashi_keirin:20170416102843j:plain

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

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

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

リスト1-1 フィールド・アクセサ部分
Option Explicit
'フィールド
Private dataSource_ As Range    '……(1)'
Private rangeOfCriteria_ As Range
Private copyTo_ As Range
'アクセサ
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)からの3行、

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

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

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

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

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を引くことで、抽出されたデータの件数をセットしている。

リスト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)

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

  • 第1引数は抽出元のデータ範囲
  • 第2引数は抽出条件のデータ範囲
  • 第3引数は抽出先のデータラベルの範囲

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

(2)からの3行、

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)からの2行、

Dim dtExtractor As DataExtractor
Set dtExtractor = New DataExtractor

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

(2)の

With dtExtractor

は、おなじみの記述。

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

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

実行結果

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

f:id:akashi_keirin:20170416102848j:plain

f:id:akashi_keirin:20170416102853j:plain

無事抽出処理ができた。

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

@akashi_keirin on Twitter