VBA最初の一歩(その7)・・・マクロ記録とオートフィルタ
オートフィルタはデータの抽出を行うエクセルの機能です。この機能を用いて
例えば得意先別売上表からのデータを抽出するマクロ記録の修正について検討します。

(前提)Sheet1に売上データ
	※一列目を項目行とし、A列から順に項目は・・・コード、得意先名、金額

■(1)オートフィルタの設定■

フィルターを設定し、A列の項目コードから"000001"を抽出する、という動作を記録すると、

Sub Macro1()

    Selection.AutoFilter
    Selection.AutoFilter Field:=1, Criteria1:="000001"
    
End Sub

となります。対象範囲はデータ領域内どこかひとつのセルを選択した状態であれば、

    Selection.AutoFilter

でもかまいませんが、予期せぬ自体を避けるためにセル範囲をセルA1から連続する
アクティブセル領域とします。その上でInputBoxメソッドにより抽出したいデータを
ユーザに指定してもらうように修正してみます。

1.必要な変数を宣言します。InputBoxメソッドの返り値を格納する文字列型変数と、
  アクティブセル領域を格納するRange型変数です。

    Dim MyCode As String
    Dim Rng As Range

2.変数RngにセルA1から連続するセル領域を格納し、フィルタを設定します。

    Set Rng = Range("A1").CurrentRegion
    Rng.AutoFilter

3.InputBoxメソッドでユーザにコード番号の入力を促します。

    MyCode = Application.InputBox("コード番号入力", Type:=2)
		※Type:=2は文字列の指定

4.変数MyCodeを抽出基準の一番目(Criteria1)に指定します。

    Rng.AutoFilter Field:=1, Criteria1:=MyCode


■(2)抽出データのコピー&ペースト■

次に、抽出したデータを利用するため、抽出結果を他シートへコピー&ペーストする
手法について考えます。

手動でコピーを行う際、抽出結果のみコピーするにはメニューから”編集”−”ジャンプ”
−”セル選択”−”可視セル”のように、シート上に表示されているデータのみを選択する
必要があります。このことを踏まえてマクロ記録を行うと・・・

Sub Macro1()

    Selection.AutoFilter
    Selection.AutoFilter Field:=1, Criteria1:="000001"

    Selection.SpecialCells(xlCellTypeVisible).Select’可視セルの選択
    Selection.Copy

    Sheets("Sheet2").Select	'シートを切り替えて貼り付け
    Range("A1").Select
    ActiveSheet.Paste

    Sheets("Sheet1").Select	'もとのシートに戻る
    Application.CutCopyMode = False
    Selection.AutoFilter	'オートフィルタ解除

End Sub

まず、VBA最初の一歩(その3)の考え方に基づいて不要なSelect命令を削り、さらに
上記(1)オートフィルタの設定の手法で変数とInputBoxメソッドを利用する方法に
手直しします。CopyメソッドのDesitination引数を利用する方法も忘れずに行いましょう。

Sub MyFilter()

    Dim MyCode As String
    Dim Rng As Range
    
    Set Rng = Range("A1").CurrentRegion 'アクティブセル領域取得
    Rng.AutoFilter          'フィルタ設定
    
    MyCode = Application.InputBox("コード番号入力", Type:=2)
    Rng.AutoFilter Field:=1, Criteria1:=MyCode 
    '変数MyCodeに格納されたデータ抽出
    
    '可視セルをコピー
    Rng.SpecialCells(xlCellTypeVisible).Copy _
                         Destination:=Sheets("Sheet2").Range("A1")
    
    Rng.AutoFilter 'フィルタ解除
    
End Sub




戻る


Excel Word Access VBA! モーグ