[[20041003122808]]　『オートフィルタ：選択操作を入力規制リストで』（u-jin）　ページの最後に飛ぶ

『オートフィルタ：選択操作を入力規制リストで』（u-jin）

マクロは自動記録しかできない初心者です。よろしくお願いします。
オートフィルターでデーター抽出するとき、その抽出内容をドロップダウンリストから選択しますが、その選択する操作を、入力規制のリストを使ってできる方法はありませんか。
　これは、年間予定表のある月だけを抽出して、印刷したいのです。そのとき標題のあるセルに抽出したい「月」を入力規制のリストを使って表示し、マクロで印刷ボタンをつくって印刷したいと考えています。

 おはようございます。
一応動くには動いたけど、┐('～`；)┌あまりぱっとしなかった。。｡･ﾟﾟ･(>_<)･ﾟﾟ･｡
でもまぁとりあえず、、、ということでお願いします。
A1からE列に何か見出しをつけてデータを入力してから、
G1に何かを入力してみてください
A列だけにフィルタをかけていますので、E列まではダミーとなります。
シート2を作業用に使っています。
シート1の見出しを右くりっく→コードを表示させて
そこに↓を貼り付けてください。
Private Sub Worksheet_Change(ByVal Target As Range)
'*************************************
'変数の宣言
Dim MyDic As Object, MyKey As String
Dim MyA As Variant, MyTbl As Range
Dim i As Long, MyRow As Long
'*************************************
'ターゲットがG1じゃなかったら中止
If Target.Address <> "$G$1" Then Exit Sub
'画面の更新を停止
Application.ScreenUpdating = False
'イベントを停止
Application.EnableEvents = False
With Me
    'フィルターがかかっていたらOFF
    If .AutoFilterMode = True Then
        .AutoFilterMode = False
    End If
    'MyTblにA列を代入
    Set MyTbl = .Range("A1", .Range("A65536").End(xlUp))
End With
'*****************************************************
'見出しを含めてデータがあったら
If Application.WorksheetFunction.CountA(MyTbl) > 1 Then
    With Me
        'ターゲットが空白か「すべて」だったら、印刷範囲をクリアにして中止
        If Target.Value = "" Or Target.Value = "すべて" Then
            '印刷範囲を解除
            .PageSetup.PrintArea = ""
            '画面の更新解除
            Application.ScreenUpdating = True
            'イベントを解除
            Application.EnableEvents = True
            Exit Sub
        End If
    End With
    'CreateObject関数でディクショナリーを生成
    Set MyDic = CreateObject("Scripting.Dictionary")
    'データを配列MyAに格納
    MyA = MyTbl.Offset(1).Value
    '変数iを配列MyAの上限までループ
    For i = 1 To UBound(MyA, 1)
        MyKey = MyA(i, 1)
        'MyKeyが重複していなかったらMyDicに追加
        If Not MyDic.Exists(MyKey) Then
                MyDic.Add MyKey, Empty
        End If
    Next i
    'シート2の
    With Worksheets("Sheet2")
        'A列をクリア
        .Columns(1).Cells.ClearContents
        .Range("A1").Value = "すべて"
        'A2から下にキーを出力
        .Range("A2", .Range("A" & MyDic.Count)).Value = Application.WorksheetFunction.Transpose(MyDic.Keys)
        'データを名前「リスト」として定義
        .Range("A1", .Range("A65536").End(xlUp)).Name = "リスト"
    End With
    '入力規則を追加
    With Target.Validation
        .Delete
        .Add Type:=xlValidateList, Formula1:="=リスト"
        .ShowInput = False
        .ShowError = False
    End With
    'A列にオートフィルターをかけて入力規則と連動させる
    '印刷範囲はE列までとしている。
    With Me
        MyTbl.AutoFilter Field:=1, Criteria1:="=" & Target.Value, VisibleDropDown:=False
        MyRow = .Range("A65536").End(xlUp).Row
        .PageSetup.PrintArea = "A1:E" & MyRow
        'データが抽出されたら
        If MyTbl.SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
            .PrintPreview
        Else
            .AutoFilterMode = False
            .PageSetup.PrintArea = ""
            MsgBox "該当するデータはありません。"
        End If
    End With
    '配列MyAの初期化
    Erase MyA
    'MyDicの開放
    Set MyDic = Nothing
'************************************************************
'データがなかったら
Else
    MsgBox "データが入力されていません。" & Chr(13) & Chr(13) & _
            "A列からE列に見出しをつけてデータを入力してください。"
    With Target
        'ターゲットをクリア
        .Value = ""
        '入力規則を削除
        .Validation.Delete
        'ターゲットの一つ下を選択
        .Offset(1).Select
    End With
        'Sheet2のA列をクリア
        Worksheets("Sheet2").Columns(1).Cells.ClearContents
End If
'***************************************************************
'MyTblの開放
Set MyTbl = Nothing
'イベントの停止を解除
Application.EnableEvents = True
'画面の更新を解除
Application.ScreenUpdating = True
End Sub
あっ、途中でマクロが停止した時などは
↓をどこかで実行してから、また実行してみてください。
Application.EnableEvents = True
多分いいとは思うけど、、私のことだから、、よろしくお願いします。σ(^◇^;)
追伸！入力規則に「リスト」という名前を範囲名に使用していますので
同じ名前がある場合は変更してからお試しください。
2004/10/4　9:35
ではでは、v(=∩_∩=)v
(SoulMan）

  素晴らしい解答ありがとうございました。実際に動かすことができました。
これから自分のファイルに組み込んでみます。分からないところがあったら
またよろしくお願いします。(u-jin)

コメント返信：

[ 一覧(最新更新順) ]

[[20041003122808]] 『オートフィルタ：選択操作を入力規制リストで』（u-jin） ページの最後に飛ぶ

[[20041003122808]]　『オートフィルタ：選択操作を入力規制リストで』（u-jin）　ページの最後に飛ぶ