エクセルのオートフィルターの消し方
- エクセルのオートフィルターを消す方法についてご教示ください。特に、シート全体を初期化する際に、フィルターがかかっている場合はフィルターも消したいです。
- オートフィルターを使ってシートを抽出した状態でデータを消すと、フィルターがかかっていない部分も残ってしまいます。フィルターがかかっている場合はフィルターを消してからデータを消す方法を教えてください。
- シートのA1～D1までにフィルターがかかっているかどうかを判定し、フィルターがあればフィルターを消してからデータを消す、フィルターがなければそのままデータを消すVBAマクロの書き方を教えてください。
- ベストアンサー
エクセルのオートフィルターがかかっていたら消すVBA
いつもお世話になっております。 作業が終了して全てのシートを初期化する場合に、オートフィルターで抽出した状態でデータを消すと、隠れていた部分が残ってしまいます。 もし、そのシートのA1～D1までにフィルターがかかっていたら、フィルターを消す、かかっていなければ、そのままシート全体のデータを消すというマクロはどう書けばよろしいのでしょうか？ -例- Sheets("ABC").Select If Range(Cells(1,1),Cells(1,4))にフィルターがかかっていたらThen フィルターを消す Cells.ClearContents Else Cells.ClearContents End If こんなことをしたいのですが、伝わりましたでしょうか？ よろしくご指南くださいませ。
- TENSAW
- お礼率79% (61/77)
- オフィス系ソフト
- 回答数1
- ありがとう数1
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
こういうことでしょうか？ ActiveSheet.AutoFilterMode = False
関連するQ&A
- エクセルＶＢＡ オートフィルタの選択を元に戻す
エクセルのＶＢＡで、次のことはできるでしょうか。 ブックの中の３つのシートはオートフィルタが設定してあり、任意で操作し、検索に使っています。（オートフィルタを設定しないしーとが２つあります) ・別のシートにチェンジしたら、チェンジ前のシートがオートフィルタで特定の行だけを表示していたら、オートフィルタを ＜すべて＞ に戻して、消えていた行を全て表示させたいのです。（オートフィルタは次回にまた使うので、データ－フィルタ－オートフィルタでオートフィルタ自体を解除してしまうような状態にはしたくありません） ・同じく、上記のことをブックを閉じるときにも実行したいのです。 ちなみに、オートフィルタをかけてあるシートには、以下のコードがあります。 よろしくお願いします。 Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) With Sheets("印刷") .Range("E15:E17").Value = _ Application.Transpose(Cells(Target.Row, 7).Resize(, 3).Value) .Range("AA16").Value = _ Cells(Target.Row, 10).Value .Range("AQ16").Value = _ Cells(Target.Row, 11).Value .Range("AX16").Value = _ Cells(Target.Row, 12).Value End With With Sheets("施設") .Range("C2").Value = _ Cells(Target.Row, 10).Value End With Cancel = True Sheets("施設").Select End Sub
- ベストアンサー
- オフィス系ソフト
- エクセルＶＢＡに関する質問です（オートフィルター）
下記のようにコマンドボタンをクリックしたら、Ｎのシートを選択し、Ｂ列（Ｆｉｅld=2)をＯ（顧客名）でオートフィルターをかけています。 これでできたと思ったら、オートフィルターをかけ、データがない場合の処理を忘れており、データがない場合は、メッセージボックスで データがありません と表示したいと考えています。 そこで （Ｉｆ Ｔｈｅｎ Ｅｌｓｅ Ｅｎｄｉｆ） ＳｕｂＴｏｔａｌ 等を用いればできるかなと思うのですが、ＶＢＡ素人の私にはできません。どなたかご教示お願いいたします。 Private Sub CommandButton1_Click() Dim N As String N = Range("U6").Value Sheets(N).Select Dim O As String O = Range("V6").Text ActiveSheet.Range("$A$1:$S$154").AutoFilter Field:=2, Criteria1:= _ "=*" & O & "*", Operator:=xlAnd この後印刷をかけています。
- ベストアンサー
- オフィス系ソフト
- コンボボックスとオートフィルタの連動
データの件数が増えてきたので、コンボボックスで選択した項目を一発で表示させるマクロを組みたいと思います。 前提は以下の通りです。 Webからの受け売りというか、書かれていた通りにやってみたのですが動作しません。どこが間違っているのでしょうか。 また、他にも方法があるようでしたらお知恵をお貸し下さい。 +++ マクロを実行させたいシートにはA3からK3までの項目があります。 そのうち、B3の項目でフィルタをかけたいです。 1.マクロを実行するシートとは別に「マスター」というシートを作成。 そこにコンボボックスにリンクさせる項目を入力。(A3:A16) セルC1にINDEX関数を置き、(A3:A16)のそれぞれの値を文字に変換。 2.その変換した文字を変数に格納 3.もし、空白を選択してしまったら、マクロから抜ける 4.オートフィルタのセットは、既にセットされていたら一旦解除し再度セット。 5.変数に格納した文字をキーにして、オートフィルタで抽出する。 +++ Sub Combo_AutoFilter() Application.ScreenUpdating = False '変数宣言 Dim 選択項目 As Variant Dim 実行シート名 As Variant '現在のシート名の格納 実行シート名 = ActiveSheet.Name '選択項目の格納 Sheets("マスター").Select 選択項目 = Cells(1, 3) If 選択項目 = Empty Then Sheets(実行シート名).Select Exit Sub End If 'オートフィルタのセット Sheets(実行シート名).Select If ActiveSheet.AutoFilterMode = True Then Selection.AutoFilter Range("A3:K3").Select Selection.AutoFilter Else Range("A3:K3").Select Selection.AutoFilter End If 'オートフィルターで選択 Selection.AutoFilter Field:=2, Criteria1:=選択項目 Range("A3").Select End Sub +++
- ベストアンサー
- Visual Basic
- エクセルＶＢＡについて教えてください。
DSUMを使ってVBAで自動計算をさせたいのですがうまくいきません。 ・Sheetsデータにデータを置いていて、A1からU1610までデータが入ってます。 ・Sheets集計用は計算させるための（条件を入れる）シートで、A1からE列まで（選択する項目によって何行目になるかわかりません。） ・mycountでE列のデータが入ってる行を出してます。 ・部屋タイプで1K～1LDKを選ぶとDSUMの式のタイプに1を入れたいのです。（1K～1LDKの場合はCells(1,3) 下記のように書いてみましたが上手くいきません。 どなたかご教授いただけると助かります。 mycount = "=COUNT(集計用!E2:E300)" Sheets("集計用").Cells(5, 7).Value = Range("g10") = " =DSUM(cells(データ!,1),1610,21),cells(データ!1,タイプ),cells(集計用!),cells(mycount,5))" '部屋タイプの選択 If Sheets("フォーム").Range("c30") = "1K～1LDK" then タイプ = 3 ElseIf Sheets("フォーム").Range("c30") = "2K～2LDK" Then タイプ = 6 ElseIf Sheets("フォーム").Range("c30") = "3K～3LDK" Then タイプ = 9 ElseIf Sheets("フォーム").Range("c30") = "4K～4LDK" Then タイプ = 12 Else Sheets("フォーム").Range("c30") = "その他" Then タイプ = 15 End If
- ベストアンサー
- Visual Basic
- 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 というエラーです。 何が悪いのか分かりません・・・。 分かる方いましたらご教授ください。よろしくお願いします。
- ベストアンサー
- その他MS Office製品
- VBAでオートフィルタ抽出後コピペ
VBA初心者で勉強中の者です。 『工事台帳シート』からオートフィルタで抽出したものを、『工事別表示シート』にコピペするコードをつくりました。 以下のものです。 Sub 工事抽出コピペ() Dim Obj As Object With Sheets("工事台帳") Set Obj = .Range("E5:E65536").Find(.Range("E2"), LookAt:=xlWhole) If Obj Is Nothing Then MsgBox "見つかりませんでした。" Sheets("工事別表示").Range("B11:F65536").ClearContents Exit Sub Else .Range("B6").AutoFilter Field:=4, Criteria1:=.Range("E2").Value .Range("F5:J65536").Copy End If End With Sheets("工事別表示").Range("B11").PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False End Sub これを起動させると、 Sheets("工事別表示").Range("B11").PasteSpecial Paste:=xlPasteValues の部分が黄色くなり、 実行時エラー'1004'「コピー領域と貼付領域の形が違うため、情報を貼り付けることができません」 という表示が出てきます。 これはどういう意味なのでしょうか？ ちなみにコピー領域セルも貼付領域セルも結合はなく、行・列の幅も同じです。 このコードもいろいろな本やサイトで教えてもらったのを参考に作っているので、私自身深く理解せずに書いているところもあります。 どなたか教えてくださる方、よろしくおねがいします。
- ベストアンサー
- オフィス系ソフト
- excel VBA ２つのプロシージャを１つに
いつもお世話になっております。 初心者ですが、苦しみながらもexcelでデータベースを作成しております。 さて Worksheet_Change のイベントが２つあり、これを一つにまとめようとしているのですが、がんばっているんですが、自分ではどうしてもうまくいかない為、投稿させていただきました。 コードは下記２つです。 また、どういったものを作ろうとしているのか説明不足でご指摘を頂戴することもありますので、試作段階のファイルですが、アップローダーにあげさせていただきました。確認頂ければ幸いです。 ■アプロダ 投稿No 4514 http://www.kent-web.com/pubc/book/test/uploader/uploader.cgi ■作ろうとしているデータベースの概要 inputシート・・・データを直接入力して、また、データや写真を閲覧をするシート dataシート・・・データを格納するシート、オートフィルタを使って、曖昧検索フィルタもここでかけたりします。 どうか良いお知恵を拝借させていただきたくよろしくお願いします。 '一つ目のプロシージャ（Noセルに数字が入ると、そのNoのデータを自動的にdataシートまで読みにいって表示させます） Private Sub WorkSheet_Change(ByVal Target As Range) 'No入力してデータ反映 Dim fRange As Range Dim fRow As Long If Target.row <> 4 Then Exit Sub If Target.Column <> 3 Then Exit Sub Set fRange = Sheets("data").Columns(1).Find(What:=Range("C4").Value, _ LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows) If (fRange Is Nothing) Then '見つからなかった？ MsgBox "入力された顧客コードが存在しません。", vbExclamation Exit Sub End If fRow = fRange.row '検索された顧客DCの行位置を求める Range("F4").Value = Sheets("data").Cells(fRow, 2).Value Range("C5").Value = Sheets("data").Cells(fRow, 3).Value Range("C6").Value = Sheets("data").Cells(fRow, 4).Value Range("C7").Value = Sheets("data").Cells(fRow, 5).Value Range("F5").Value = Sheets("data").Cells(fRow, 6).Value End Sub '二つ目のプロシージャ（写真を表示させるためのコードです） Private Sub Worksheet_Change(ByVal Target As Range) Select Case Target.Address Case "$k$4" myLoadPicture "board_Image", Target.Text, Range("I5") Case "$K$17" myLoadPicture "map_Image", Target.Text, Range("I18") Case Else Exit Sub End Select End Sub
- ベストアンサー
- オフィス系ソフト
- VBAについて質問です。
VBAについて質問です。 まとまったデータがあるところから検索したい月及び各項目のデータを検索し、項目シート事に抽出するという作業を行なっています。そこで問題がでました。6月にはデータはあるが、5月にはデータはない。 そうすると以下のコードの場合デバックが入り、他の検索が出来ません。 どうしたらよいのでしょうか？ 分かる方がいらっしゃいましたらどうかお願い致します。 'シートの変更 Range("B30").Select Sheets("東京").Select '●Sheet2書込み行 Sheets("東京").Range("A5").CurrentRegion.Clear Sheets("東京").Range("A5:F5").Value = _ Array("依頼書No.", "受付日日", "担当者", "枚数", "工数", "備考") Row2 = 5 For R = 2 To Sheets("日報").Cells(Rows.Count, "A").End(xlUp).Row If Sheets("東京").Range("A2") = Sheets("日報").Cells(R, "A") And _ Sheets("東京").Range("B2") = Month(Sheets("日報").Cells(R, "C")) Then Row2 = Row2 + 1 Sheets("東京").Cells(Row2, "A") = Sheets("日報").Cells(R, "B") Sheets("東京").Cells(Row2, "B") = Sheets("日報").Cells(R, "D") Sheets("東京").Cells(Row2, "C") = Sheets("日報").Cells(R, "F") Sheets("東京").Cells(Row2, "D") = Sheets("日報").Cells(R, "I") Sheets("東京").Cells(Row2, "E") = Sheets("日報").Cells(R, "K") Sheets("東京").Cells(Row2, "F") = Sheets("日報").Cells(R, "L") End If Next R '●抽出結果を日付で並べ替え If Row2 = 5 Then MsgBox "該当データなし！" Else Sheets("東京").Range("A5:F" & Row2).Sort _ Key1:=Range("B6"), Order1:=xlAscending, _ Header:=xlYes, OrderCustom:=1, MatchCase:=False, _ Orientation:=xlTopToBottom, SortMethod:=xlPinYin End If Sheets("東京").Select Range("B5:B200").Select Selection.NumberFormatLocal = "yyyy/m/d" Rows("5:5").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .ShrinkToFit = False .MergeCells = False End With このあとに式を入れて、罫線を入れてコピーして、というコードが入っています。 どうぞ宜しくお願い致します。
- ベストアンサー
- その他MS Office製品
- Excel（VBA）を活用したマクロについて
ExcelのVBAでマクロを作成していますが、プログラムの壁にぶつかってしまいました。恐れ入りますが、ご回答をお願い致します。 具体的な作業： ３０程度のデータをリストボックスに表示させ、必要なデータを選択してもらうプログラムです（ここまではできています）。選択されたデータは作業者にカラーで確認できるようにしましたが、これらの抽出データをバックアップするために、行列を入れ替え「左から右へ詰めて」別シート（Sheet2)へ貼り付けるにはどうすればよいか、アドバイスをお願いします。 お恥ずかしながら、できているところまで掲載させていただきます。 Private Sub データ選択_Click() Dim 数 As Integer If lst一覧.ListIndex = -1 Then MsgBox "分析するデータを選択してください" lst一覧.SetFocus Else For 数 = 0 To lst一覧.ListCount - 1 If lst一覧.Selected(数) = True Then Cells(20 + 数, 23).Resize(, 8).Interior.ColorIndex = 36 Cells(20 + 数, 23).Resize(, 8).Copy Sheets("Sheet2").Select Range("ここがわかりません").Select Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=True, Transpose:=True Sheets("Sheet1").Select Range("A24").Select End If Next 数 End If End Sub
- ベストアンサー
- Visual Basic
- VBA（エクセル）で教えて下さい。開いていないBOOKの貼り付け
VBA（エクセル）で教えて下さい。開いていないBOOKのシートを開いているBOOKのシートに貼り付けで、開いているBOOKから開いていないBOOK名を指定したいのですが、 現在開いているエクセルです。 SHEETS(Type)のRANGE（A1）に閉じているBOOK名を入力します。 SHEETS（In）に閉じているBOOKのSHEETSを貼り付けたいのですが、 Ex = Sheets("Type").Range("A1") が無いと閉じているEx.xlsを貼り付けます。 このExと言うBOOK以外も多々コピーしたいのですが、どのように書けば良いか分からず、 是非、教えて下さい。 Sub a1() Dim wsSrc As Worksheet, WS As Worksheet Dim PasteR As Range Dim x As Long Sheets("In").Select Cells.Select Selection.Delete Shift:=xlUp Range("A1").Select 'If Worksheets(1).Name = "STEP1" Then ' Worksheets(1).Activate ' Cells.ClearContents ' Else 'Worksheets.Add(Before:=Worksheets(1)).Name = "一覧" 'End If Ex = Sheets("Type").Range("A1") Set wsSrc = ActiveSheet Workbooks.Open "C:\WINDOWS\デスクトップ\test\Ex.xls" For Each WS In Worksheets x = WS.Range("A1").CurrentRegion.Rows.Count If WS.Index = 1 Then Set PasteR = wsSrc.Range("A1") Else Set PasteR = wsSrc.Range("A65536").End(xlUp).Offset(1) End If WS.Range(WS.Cells(1, 1), WS.Cells(x, 44)).Copy PasteR Set PasteR = Nothing Next ActiveWorkbook.Close False Set wsSrc = Nothing End Sub
- ベストアンサー
- オフィス系ソフト
お礼
xls88さん、 早速のご回答ありがとうございました。 おはずかしい。。。そういうことです。 なぜ気がつかなかったんだろう。。。 また機会がありましたらよろしくお願いいたします。