• ベストアンサー

エクセルで閉じるときのマクロ

あるエクセルファイルがあり、 その一枚のシートにはオートフィルタ (A~Z列まで)を使用しています。 【質問1】 ファイルを保存して閉じる際、 オートフィルタで抽出したものを 「すべて」に戻す、 つまりなにも抽出されていない(=左端の行番号が黒字) に戻すマクロはどこにどのように書けばよいでしょうか? オートフィルタを戻すマクロは、 'オートフィルタのあるシートを選択 Sheets("買取リスト").Select 'T列のオートフィルタを「すべて」にする Selection.AutoFilter Field:=22 というところまでは理解できました。 【質問2】 上記のマクロを Sheets("顧客リスト") から、Sheets("商品リスト")へ移動した際、 ボタン等を使用せずに、 (ただ、下のタブをクリックするだけで) 実行させることは可能でしょうか? 可能であれば、どこにどのように記述すれば よいでしょうか??  よろしくお願いします。

質問者が選んだベストアンサー

  • ベストアンサー
  • vbafriend
  • ベストアンサー率47% (17/36)
回答No.5

こんばんわ。 これが30本あれば、一本一本すべてにしていくので、時間がかかるのではないかと危惧して、・・・・・・・・ すっきりとした1発解除方法は無いようです。オートフィルターを一度画面から消して再度同じ場所に表示するという方法を取るか、Selection.AutoFilter Field:=22をオートフィルターの数だけ書くという方法しかないようです。オートフィルターの理屈を考えてみれば、お解りになると思います。 >質問2に関しては、ワークシートのタブをダブルクリックする習慣が私も含めありませんので、できればシングルクリックで、実行できる方法があればご教示ください。 Private Sub Workbook_SheetActivate(ByVal Sh As Object) ここに、コードを書く。 End Sub シートが選択されてアクティブになった時点でマクロが走り出します。 ご不明な点がございましたらご遠慮なく補足要求して下さい。

oresama
質問者

お礼

とても参考になりました。 何度もお答えいただき、ありがとうございました。

その他の回答 (5)

  • papayuka
  • ベストアンサー率45% (1388/3066)
回答No.6

再びこんにちは。 A1から始まるフィールドデータを想定してたので、UsedRangeで良いかと思ったんですが各シート毎にフィルター範囲が異なるなら、それを保持するようにしないとダメです。 標準モジュールに書く Sub Auto_Close() Dim ws As Worksheet Dim r As Range  For Each ws In Worksheets   If ws.AutoFilterMode Then    Set r = ws.AutoFilter.Range    ws.AutoFilterMode = False    r.AutoFilter   End If  Next ws  Set r = Nothing End Sub ThisWorkBookに書く Private Sub Workbook_SheetActivate(ByVal Sh As Object) Dim r As Range  If Sh.AutoFilterMode Then    Set r = Sh.AutoFilter.Range    Sh.AutoFilterMode = False    r.AutoFilter  End If  Set r = Nothing End Sub 前回の最後にも書いた通りサンプルです。 どんなシート構成でどんな使用を想定しているか等、言葉で伝えるのは難しいですし、こちらは想像でしか書けません。 ご自身で修正する努力も必要かと思いますよ。

oresama
質問者

お礼

>ご自身で修正する努力も必要かと思いますよ。 おっしゃる通りですね。 何度もお答えいただきまして、 ありがとうございました。 お蔭様で希望どおりのものができました。

  • vbafriend
  • ベストアンサー率47% (17/36)
回答No.4

こんにちは。 ▼を残したまま、抽出を解除する方法はありませんでしょうか? Selection.AutoFilter Field:=22この式で、ボタンは消えずに抽出は解除できると思うのですが、何か不具合があるのでしょうか?どのような不具合なのかを教えて下さい。 >質問2に関しては、ワークシートのタブをダブルクリックする習慣が私も含めありませんので、できればシングルクリックで、実行できる方法があればご教示ください。 ダブルクリックで実行するのが一番早い解決方法なのですが、どうしてもお好みで無いならば、マクロを走らせるタイミングと貼り付けするシートのシート名を教えて下さい。 お手数をおかけいたします。よろしくお願いいたします。

oresama
質問者

補足

> Selection.AutoFilter Field:=22 これは、22列目(T列)のフィルタを すべてにする式ですよね。 これが30本あれば、一本一本すべてにしていくので、 時間がかかるのではないかと危惧して、 一発解除(ただし、フィルタは残したまま) はないものかと思って、再質問させていただいた次第です。 >マクロを走らせるタイミング 任意のタブをクリックした場合 シート名 買取 得意先 在庫 >貼り付けするシートのシート名 list が、フィルターを解除したいシート名です。 どうぞよろしくお願いします。

  • vbafriend
  • ベストアンサー率47% (17/36)
回答No.3

初めまして。 【質問1】 オートフィルターがかかっているブック名をA・行を1行目として workbooks("A.xls").worksheets("シート名").rows("1:1").Autofilter これでオートフィルターが削除され、選択されていない状態に戻ります。 【質問2】 ThisWorkbookのモジュールシートで下記のイベントを利用すればよろしいかと思います。 Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) End Sub これを使うと、シートのタブをダブルクリックした時にマクロが走り出します。 ご不明な点等がございましたら、ご遠慮なく補足要求して下さい。

oresama
質問者

補足

上記マクロを実行すると、 オートフィルタが解除されてしまい、 ▼のアイコンがなくなってしまいます。 ▼を残したまま、抽出を解除する方法はありませんでしょうか? 質問2に関しては、 ワークシートのタブをダブルクリックする習慣が 私も含めありませんので、できればシングルクリックで、 実行できる方法があればご教示ください。

  • papayuka
  • ベストアンサー率45% (1388/3066)
回答No.2

こんにちは。 標準モジュールに下記でブックを閉じる時にフィルターを全て戻します。 Workbook_BeforeClose イベントでも同じです。 Sub Auto_Close() Dim ws As Worksheet  For Each ws In Worksheets   If ws.AutoFilterMode Then     ws.AutoFilterMode = False     ws.UsedRange.AutoFilter   End If  Next ws End Sub ThisWorkbookに下記で、アクティブになった時にフィルターを解除します。 Private Sub Workbook_SheetActivate(ByVal Sh As Object)  If Sh.AutoFilterMode Then    Sh.AutoFilterMode = False    Sh.UsedRange.AutoFilter  End If End Sub サンプルなので、Range指定がシートによっては上手くいかないかも。。。

oresama
質問者

お礼

ご教示ありがとうございます。 早速試したところ、 おおっ!っと思ったのですが、 よくみると、 オートフィルタのある行がずれていました。 オリジナルは、 シート1は、A10:AO10にあったのがA1:CS10に。 シート2は、A3:AO3にあったのが、A2:BC2に、 フィルタが移動してしまいました。 この解決策はございますか?

回答No.1

質問1 VBEditor の オブジェクトエクスプローラー で ThisWorkbookをダブルクリックします。 表示されたコード内で、次のいずれかのイベントプロシージャの中にマクロを記入してみてください。 '-------------------------------------------------------- Private Sub Workbook_BeforeClose(Cancel As Boolean) End Sub '-------------------------------------------------------- Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) End Sub '-------------------------------------------------------- Private Sub Workbook_Open() End Sub それぞれの違いについてはヘルプ等をご参考に・・・ 質問2 質問1と同じ場所で次のプロシージャの使います '-------------------------------------------------------- Private Sub Workbook_SheetActivate(ByVal Sh As Object) End Sub

関連するQ&A

  • エクセルのマクロ

    勉強を始めたばかりで処理を繰り返す項目をいろいろ調べたのですがうまくいきません。教えてください。 オートフィルタで3列目を”東京 ”という文字でを抽出したあとである処理をし、その後同じ列で今度は”神奈川 ”を選び同様の処理をする。また今度は 次は"千葉”と繰り返したいのです。 マクロを見てみると Selection.AutoFilter Field:=3, Criteria1:="1"    何らかの処理 Selection.AutoFilter Field:=3, Criteria1:="2"    何らかの処理 Selection.AutoFilter Field:=3, Criteria1:="3"    何らかの処理 となっています。こうなると必要な数だけ これをコピーしないといけないので ループのようなもので下記の■の部分の 数字を1.2.3.~と処理を繰り返す毎に 増やして生きたいのです。 そしてリストの最後にきたらおしまいにしたいのですが・・・・。FOR NEXT とか DO LOOP とか 試しましたが、私の幼稚な知識ではうまく動いてくれませんでした。すみませんがよろしくお願いします。 Selection.AutoFilter Field:=3, Criteria1:="■" 処理

  • マクロ オートフィルタで困っています。

    マクロ オートフィルタで困っています。 1列目と2列目からそれぞれ条件をフィルタで抽出し、抽出された行を削除するマクロを組んだのですが(下記)、Bの条件が表にない場合に2行目から下が全て削除されてしまいます。 元の表は毎週変わるため、抽出する条件があるかないかはその時次第です。 オートフィルタにこだわってはいませんが、その他の抽出方法もいまいち分からず……。 どのようにすればよいのか、教えていただけますでしょうか。 宜しくお願い致します。 <マクロ> Sub Macro() Selection.AutoFilter Field:=1, Criteria1:="A" Selection.AutoFilter Field:=2, Criteria1:="B", Operator:=xlAnd Dim gyou(1) As Long gyou(0) = 2 gyou(1) = Range("A1").CurrentRegion.Rows.Count Rows(gyou(0) & ":" & gyou(1)).Select Selection.Delete Shift:=xlUp End Sub

  • エクセルマクロVBAについて

    エクセルマクロVBAについて、こんなこと出来ますか? ■A列からAS列の1行目にヘッダー情報をもつデータベース ■A列に担当者名 ■A列にオートフィルタをかけて各担当ごとにデータを抽出したものを別シートに貼り付けて自動印刷したい ■担当者は都度変わるので、Criteria1:="xxx"というようには直接書けない(担当名を自動で抽出したい) ■担当者の数も都度変わる ■補足 一行のデータを特定の雛形に転記する必要があるので別シートに出したいです ちなみに、アナログで記録したコードは以下です。 Sub test1() Sheets("データ抽出シート").Select ActiveSheet.Range("$A$1:$AS$300").AutoFilter Field:=1, Criteria1:="山田" Range("$A$1:$AS$300").Select Selection.Copy Sheets("抽出データ貼付シート").Select Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveWindow.SelectedSheets.PrintOut Copies:=1 Sheets("データ抽出シート").Select ActiveSheet.Range("$A$1:$AS$300").AutoFilter Field:=1, Criteria1:="斉藤" Range("$A$1:$AS$300").Select Selection.Copy Sheets("抽出データ貼付シート").Select Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveWindow.SelectedSheets.PrintOut Copies:=1 Sheets("データ抽出シート").Select ActiveSheet.Range("$A$1:$AS$300").AutoFilter Field:=1, Criteria1:="田中" Range("$A$1:$AS$300").Select Selection.Copy Sheets("抽出データ貼付シート").Select Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveWindow.SelectedSheets.PrintOut Copies:=1 End Sub これ、担当者の抽出を自動でなんとかなりませんか?

  • マクロを実行するとフリーズしてしまう。

    マクロを実行するとフリーズしてしまいます。 パソコンが原因なのでしょうか? マクロは Sub 抽出() ' '「貼り付け」シートを'一度全てクリアする Sheets("貼り付け").Select Cells.Select Selection.Clear '「元」シートを選択 Sheets("元").Select 'フィルタかけなおし Rows("1:1").Select Selection.AutoFilter Selection.AutoFilter '’抽出前「*」選択 Selection.AutoFilter Field:=1, Criteria1:="~*" '全て選択してコピー Cells.Select Application.CutCopyMode = False Selection.Copy '「元」を貼り付ける Sheets("貼り付け").Select Cells.Select ActiveSheet.Paste 'フォントを「9」 With Selection.Font .Size = 9 End With End Sub です。 パソコンのスペックは celeron&reg; cpu3.20GHz 3.19GHz 1GB RAM です。 最近VBAを覚え始めたばかりな者です。 仕事のデータではもっと複雑なマクロを実行していてもパソコンはなんともないので マクロに原因があるのではなくパソコンに原因があるのでしょうか? (上記のマクロを実行しているのは自宅のPCです) よろしくお願いします。

  • エクセルマクロ フィルター

    宜しくお願い致します。 Set flt = Range("j6") j6の値が49727491で別シートからこの値を含むリストを オートフィルターで抽出したいですがリストの方の値が 237578-20080617-49727491となってます j6を含む形で抽出するにはどうしたい良いでしょうか? Workbooks("book1.csv").Sheets("book1").Range("A1").AutoFilter Field:=1, Criteria1:=flt

  • Excelマクロでオートフィルターからコピペ

    ファイルのB列の値から0以外の値をオートフィルターで抽出し、値を、別のファイルのD列の一番下に貼りつけるマクロを作っていますがうまくいきません。 今作ったのは Sub macro1() If ActiveSheet.AutoFilterMode = False Then Range("A:G").Select Selection.AutoFilter Else Selection.AutoFilter Range("A:G").Select Selection.AutoFilter End If Selection.AutoFilter Field:=2, Criteria1:="<>0", Operator:=xlAnd Range("A1").Select Range("B2", Range("B2").End(xlDown)).Select Selection.Copy Windows("貼りつけるファイル名").Activate Cells(Rows.Count, 4).End(xlUp).Offset(1).Select ActiveSheet.Paste End Sub です。 フィルターで0以外の値を抽出しコピーまではできていますが、貼りつけるところでエラーがでます。 Microsoft Visual Basic 400 というエラーです。 何が悪いのか分かりません・・・。 分かる方いましたらご教授ください。よろしくお願いします。

  • 【Excel】 マクロを補足してください。

    A1をダブルクリックすると E、D、C、B列のオートフィルタで「すべて」を 選択するようにしました。 続けて 同じシートで、B1をダブルクリックするとE、D、C列の オートフィルタで「すべて」を選択、 C1をダブルクリックするとE、D列のオートフィルタで 「すべて」を選択するようにしたいのですが、 どのようにしたらよいのでしょうか。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Address <> "$A$1" Then Exit Sub Cancel = True Selection.AutoFilter Field:=5 Selection.AutoFilter Field:=4 Selection.AutoFilter Field:=3 Selection.AutoFilter Field:=2 End Sub お願いいたします。

  • マクロの記述をもっとシンプルにしたい

    このサイトでいただいた回答を利用し、また、マクロの記録を使って切り貼りして何とかやりたいことができるようになったマクロですが、記述に無駄があると思います。どのように書きかえるともっとスマートになるでしょうか。 作ったのは、190数名の数学と英語の点数を入力し、オートフィルタを使ってまず、数学の100点満点を取ったものを抽出します。そのリストをコピーし、隣のシートにコピーします。次に同じく数学ですが、60点未満のものを抽出し、それをコピーし、隣のシートのさっきコピーした隣にコピーします。それからオートフィルタを解除して、同じことを英語にも行います。最後に4つの表が並んだシートの不要な列を削除し、タイトルをつけ、列幅を調節し、オートフィルタを解除して終了します。 以下にマクロの記述をコピーします。まだなステイトメントばかりだと思いますので、アドバイスお願いいたします。 Sub 条件生徒抽出シンプル版new() Dim wS As Worksheet Set wS = Worksheets("Sheet2") wS.Cells.Clear With Range("A1").CurrentRegion .AutoFilter field:=5, Criteria1:=100 '数学の満点者を抽出 .Copy wS.Range("A1") '上のリストをコピー .AutoFilter field:=5, Criteria1:="<60" '数学の不合格者を抽出 .Copy wS.Range("h1") '上のリストをコピー Selection.AutoFilter '元データリストのオートフィルタを解除 .AutoFilter field:=6, Criteria1:=100 '英語の満点者を抽出 .Copy wS.Range("o1") '上のリストをコピー .AutoFilter field:=6, Criteria1:="<60" '英語の不合格者を抽出 .Copy wS.Range("v1") '上のリストをコピー End With Sheets("Sheet2").Select Range("A:A,F:F,H:H,M:M,O:O,S:S,V:V,Z:Z").Select Selection.Delete 'コピーした表の不要な列を削除 Rows("1:1").Select Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 'タイトル行を追加 Range("A1").Select ActiveCell.FormulaR1C1 = "数学満点者" Range("F1").Select ActiveCell.FormulaR1C1 = "数学不合格者" Range("K1").Select ActiveCell.FormulaR1C1 = "英語満点者" Range("P1").Select ActiveCell.FormulaR1C1 = "英語不合格者" Rows("2:2").Select Selection.HorizontalAlignment = xlCenter '追加したタイトルをセンタリング Columns("A:A").ColumnWidth = 4.63 '各列の幅を変更 Columns("C:C").ColumnWidth = 12 Columns("C:C").ColumnWidth = 12.75 Columns("D:D").ColumnWidth = 6.38 Columns("F:F").ColumnWidth = 4.63 Columns("H:H").ColumnWidth = 12.75 Columns("I:I").ColumnWidth = 6.38 Columns("K:K").ColumnWidth = 4.63 Columns("M:M").ColumnWidth = 12.75 Columns("N:N").ColumnWidth = 6.38 Columns("P:P").ColumnWidth = 4.63 Columns("R:R").ColumnWidth = 12.75 Columns("S:S").ColumnWidth = 6.38 Sheets("今週の点数").Select Selection.AutoFilter 'オートフィルタを解除 End Sub

  • エクセル マクロ:文字変更

    教えてください。 sheet5にデータがあります。 マクロを実行すると、一番右の列のセルに○があると●と書き換える 一番右の列のセルに△があると▲と書き換えるコードを作成しています。 下記のコードでは時間がかかってしまいます。 省略 If Sheets("sheet5").Cells(r, cmax).Value = "○" Then Sheets("sheet5").Cells(r, cmax).Value = "●" 省略 AutoFilterを使用してマクロを作成しましたが、列に○と△が両方無いと 範囲指定したセルがすべて▲となってしまいます。 下記コードをどのように手直ししたらよいのか教えて頂けないでしょうか。 よろしくお願いします。 Sub 文字変更() Dim c As Integer Dim cmax As Integer Dim rmax As Long With Sheets("sheet5") rmax = .Range("A3").End(xlDown).Row cmax = .Range("A3").End(xlToRight).Column .Rows("1:1").Select Selection.AutoFilter For c = 2 To cmax Selection.AutoFilter Field:=c, Criteria1:="○" .Cells(1, c).Offset(1, 0).Select .Range(Selection, Cells(rmax, c)).Value = "●" Selection.AutoFilter Field:=c, Criteria1:="△" .Cells(1, c).Offset(1, 0).Select .Range(Selection, Cells(rmax, c)).Value = "▲" Selection.AutoFilter Field:=c Next c End With Selection.AutoFilter End Sub

  • エクセル97でマクロを使って、シート間の編集作業をしたい。

    エクセル97を使って、データの編集をしたいのですが、 オートフィルタで抽出したものを他のシートに貼りつけるマクロなんていうのは 出来ないのでしょうか? 一応試しにやってみたところ、 Sub ○○コピペ() ' ' ○○コピペ Macro ' マクロ記録日 : 2003/2/  ユーザー名 : ' ' Selection.AutoFilter Field:=3, Criteria1:="=**○○**", Operator:=xlAnd Range("A11:I3100").Select Selection.Copy Sheets("○○").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Range("E2").Select End Sub と、このようになりました。 これでは、当然使い物になりません(汗) アクセスのクエリをインポートしてきたものを、 それぞれのシートに振り分ける(12シート分)という作業です。 マクロにしたいのは、 オートフィルのオプションを使って抽出 コピー&指定のシートの指定のセル(E2)からペースト です。 最終的にボタンにしてツールバーに常駐させるのですが、ボタンはシート数と同じ12個 作るつもりです。 (もちろん1個ですめば尚理想的なのですが) 指導の程、宜しくお願いいたします。

専門家に質問してみよう