オートフィルタを用いて、不要データを除く | カメレオンのVBA

カメレオンのVBA

VBAの私的メモ書き

事前に[設定]シートに条件を設定

Sheet1 に元データがある

Sheet2 へデータを映して加工する

Sheet3 に抽出結果を出力する

≪コード≫
    '[設定]シートにある抽出条件以外のデータを抜き出す
    Const myFlag As String = "不要"
    Dim x As Long
    Dim i As Long
   
    Dim myFiNo As Long
    Dim myStr As String
   
    '前回設定したフィルタが残っていることを考えて二回クリアを実行する
    With Sheets("Sheet2")
        .Cells.Clear
        .Cells.Clear
   
        'Sheet1 を Sheet2 にコピーする
        Sheets("Sheet1").Range("A1").CurrentRegion.Copy .Range("A1")
       
        '[Sheet2]を並べ替えることでSpecialCellsを使用したときにエラーが生じにくくなる
        .Range("A1").CurrentRegion.Sort Key1:=.Cells(2, myFiNo), Order1:=xlAscending, Header:=xlYes
   
        'Sheet2の1行目のもっとも右に抽出非対称項目を設定する
        x = .Range("A1").CurrentRegion.Columns.Count + 1
        .Cells(1, x).Value = myFlag
       
        'フィールド番号を把握する
        i = 2
        Do While .Cells(1, i).Value <> ""
            If Sheets("設定").Cells(1, "A").Value = .Cells(1, i).Value Then
                myFiNo = i
                Exit Do
            End If
            i = i + 1
        Loop
       
        '[設定]シート-A列を元に不要なデータに印をつける
        i = 2
        Do While Sheets("設定").Cells(i, "A").Value <> ""
            myStr = Sheets("設定").Cells(i, "A").Value
       
            .Range("A1").AutoFilter Field:=myFiNo, Criteria1:=myStr
           
            '可視セルの[非抽出]列に印をつける
            .Columns(x).SpecialCells(xlVisible).Value = myFlag
           
            i = i + 1
            .AutoFilterMode = False
        Loop
   
        '[Sheet3]シートにデータをコピーする準備
        Sheets("Sheet3").Cells.Clear
       
        '[Sheet2]シ―トから[Sheet3]シートへ不要なデータ以外(必要なデータのみ)を抽出
        '[設定]シート-C1~C2セルに事前に設定をしておく
        .Range("A1").CurrentRegion.AdvancedFilter _
        Action:=xlFilterCopy, _
        CopyToRange:=Sheets("Sheet3").Range("A1"), _
        CriteriaRange:=Sheets("設定").Range("C1:C2"), _
        Unique:=True

         'ダミーで作った項目名を消す
     Sheets("Sheet3").Cells(1, x).Clear
    End With