- ベストアンサー
マクロ:フィルタの選択について
例 A列に野菜の種別(大根やトマトなど)が入力されており B列に県名が入力されています。c列以降もあり。 フィルタでA列の野菜名を選択し、抽出された結果を別シートに 貼るという野菜別のシートを作る単純な作業の繰り返しを マクロで設定したいのですが マクロの記録で行うと、フィルタで野菜名を選択する時に Selection.AutoFilter Field:=4, Criteria1:="大根" というように、名前が入力されています。 フィルタの選択を上から下に4つ目、5つ目という感じで 下に選択していくマクロを教えて頂ければと思います。 また他に良い方法がありましたら、アドバイス宜しくお願い致します。
- pl00lq
- お礼率86% (85/98)
- オフィス系ソフト
- 回答数5
- ありがとう数4
- みんなの回答 (5)
- 専門家の回答
質問者が選んだベストアンサー
こんばんは。 細かい点を修正しました。シート名は最初に考えていたのですが、忘れていましたので加えます。 それと、副産物としてできた、シートの並べ替えプログラムと、シートの初期化のプログラムもつけて置きましたので、何かの時に役に立つと思います。バグはないつもりですが、一度、コードをざっと見てから試してみてください。 データシートを、シート1 なら、そのままで良いのですが、右からシート1,2 と置いて置いておきたい場合は、以下を、= 2 と入れてあげます。 Const INI As Integer = 1 'そのままにして置くシート数 '標準モジュール '------------------------------------------- Const INI As Integer = 1 'そのままにして置くシート数 (INI >1) Sub FilterTest2() 'オートフィルタから、個別データのシートの移し替えのプログラム Dim r As Range Dim Ar() As Variant Dim i As Long Dim j As Long Dim c As Variant j = Worksheets.Count 'シートの元の数 If INI < 1 Then Exit Sub '0の場合は、マクロは進まない。 With Worksheets("Sheet1") If .FilterMode Then .ShowAllData With .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp)) .AdvancedFilter Action:=xlFilterInPlace, Unique:=True Set r = .SpecialCells(xlCellTypeVisible) End With ReDim Ar(r.Count - 1) For Each c In r.Cells 'タイトルは抜く Ar(i) = c.Value i = i + 1 Next c .ShowAllData If (UBound(Ar) + INI) > j Then 'Sheet抜く For i = 1 To (UBound(Ar) - j + INI) 'Sheet を抜く Worksheets.Add After:=Worksheets(Worksheets.Count) Next i End If i = 1 .Select For i = 1 To UBound(Ar) .Cells(1, 1).CurrentRegion.AutoFilter _ Field:=1, _ Criteria1:=Ar(i) With .AutoFilter.Range .SpecialCells(xlCellTypeVisible).Copy Worksheets(i + INI).Range("A1") 'Sheet を抜く Worksheets(i + INI).Name = Ar(i) 'シート名をつける End With Next .Range("A1").AutoFilter End With End Sub '------------------------------------------- Sub Sample_SortWorksheet() 'シートの並べ替え(ただし、JISコード並び) Dim sName As String Dim iCount As Integer Dim i As Integer Dim j As Integer Application.ScreenUpdating = False iCount = Worksheets.Count For i = INI + 1 To iCount - 1 'シート名の最小値を取得します sName = Worksheets(i).Name For j = i + 1 To iCount If Worksheets(j).Name < sName Then sName = Worksheets(j).Name End If Next 'シート名が最小のシートを現在の先頭に移動する Worksheets(sName).Move Before:=Worksheets(i) Next Worksheets(1).Select Application.ScreenUpdating = True End Sub '------------------------------------------- Sub SheetClear() 'シートの消去とシート名の初期化 Dim i As Long For i = INI + 1 To Worksheets.Count 'シート2~ Worksheets(i).UsedRange.Clear Worksheets(i).Name = "Sheet" & CStr(i) Next i End Sub
その他の回答 (4)
- mt2008
- ベストアンサー率52% (885/1701)
No.2です。 > このマクロは今使用しているマクロのフィルタ選択の箇所に > 組み込むのでしょうか? そうです。 「 '取得した要素を表示」以前の部分で、配列sTempを作り、ループを回して、フィルターをかけて別シートに貼っていってください。 「 '取得した要素を表示」以降の部分は、配列sTempに全ての要素が入ったいることを見えるようにしただけですので、本来は不要です。
お礼
ご回答ありがとうございます。 上記の通り実際にやってみます。ありがとうございました!
- Wendy02
- ベストアンサー率57% (3570/6232)
こんにちは。 注意:Sheet1に元のデータがあるとして、Sheet2 目以降はすべて空の状態にしてください。もしデータがあったら上書きされてしまいます。必要な分だけ、シートが自動的に増えますから、シート数がたらなくても大丈夫です。 ただし、質問の疑問点としては、 > Selection.AutoFilter Field:=4, Criteria1:="大根" このField:=4 というのが、質問内容と矛盾しているように思います。 A列が野菜名と書いているのに、Field:=4では、列が違います。 あくまでも、以下のコードは、A1 から、表が行列(Matrix)で出来上がっているものとして作られています。 '------------------------------------------- 'Option Explicit Sub FilterTest1() Dim r As Range Dim Ar() As Variant Dim i As Long Dim j As Long Dim c As Variant With Worksheets("Sheet1") If .FilterMode Then .ShowAllData With .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp)) .AdvancedFilter Action:=xlFilterInPlace, Unique:=True Set r = .SpecialCells(xlCellTypeVisible) End With ReDim Ar(r.Count - 1) For Each c In r.Cells 'タイトルは使用しない Ar(i) = c.Value i = i + 1 Next c .ShowAllData If (r.Count - 1) > Worksheets.Count Then j = (r.Count - 1) - Worksheets.Count For i = 1 To j Worksheets.Add After:=Worksheets(Worksheets.Count) Next i End If i = 1 .Select For i = 1 To r.Count - 1 .Cells(1, 1).CurrentRegion.AutoFilter _ Field:=1, _ Criteria1:=Ar(i) With .AutoFilter.Range .SpecialCells(xlCellTypeVisible).Copy Worksheets(i + 1).Range("A1") End With Next .Range("A1").AutoFilter End With End Sub
補足
このまま使用して即作成できました。 ありがとうございます。 Field:=4は間違いです。実際には4列目に野菜名が あって作っていたのですが、後から1列目に移動しました。 シートが自動的に増えますが それぞれにシート名をつけるとしたら この場合どこに入れたらいいのでしょうか? ActiveSheet.Name = Range("A2") を使用していました。 ご教示宜しくお願い致します。
- mt2008
- ベストアンサー率52% (885/1701)
フィルタを掛けて、その結果を別シートに貼る所は出来るのですよね? 後は、A列の全要素が取り出せれば良いと理解しました。 こんな感じでA2以下のセルの全要素を取得して、要素毎にフィルタを掛けては如何でしょう。 Sub Sample() Dim nRowA, nCount, i Dim sData, sTemp nRowA = Cells(Rows.Count, 1).End(xlUp).Row ReDim sTemp(0) nCount = 0 For i = 2 To nRowA sData = Cells(i, 1).Value If Application.WorksheetFunction.CountIf(Range(Cells(i + 1, 1), Cells(nRowA + 1, 1)), sData) = 0 Then ReDim Preserve sTemp(nCount) sTemp(nCount) = sData nCount = nCount + 1 End If Next i '取得した要素を表示 For i = 0 To (nCount - 1) sStr = sStr & sTemp(i) & "," Next i MsgBox ("要素数:" & nCount & " 要素:" & sStr) End Sub
補足
要素が表示され、OKをクリックしましたが何も動作がなく?? このマクロは今使用しているマクロのフィルタ選択の箇所に 組み込むのでしょうか? すみません、宜しくお願い致します。
- KURUMITO
- ベストアンサー率42% (1835/4283)
元のデータがシート1に入力されているとします。 A2セルから下方に野菜名があるとして、フィルタを行った結果をシート2に貼り付けるとして、フィルタで野菜名を選択するときですが次のようにしてはどうでしょう。 例えばシート2のA1セルにシート1のA列で最初に出てくる野菜名が1で、次のでてくる野菜名が2のようにその数値を入力することでシート1でのフィルタが行われるようにします。そのためにシート1には予め作業列を用意します。 例えばシート1のD2セルに次の式を入力し下方にオートフィルドラッグします。 =IF(COUNTIF(A$2:A2,A2)=1,MAX(D$1:D1)+1,"") これで最初にA列に出てくる野菜名に1が、次に出てくる野菜名に2が・・・と番号が振られます。 そこでマクロの作成ですがシート2について次のようなマクロにしてはどうでしょう。 Private Sub Worksheet_Change(ByVal Target As Range) Set WS1 = Worksheets("Sheet1") Set WS2 = Worksheets("Sheet2") If Target = WS2.Range("A1") And WS2.Range("A1") <> "" Then If Target.Value <= WorksheetFunction.Max(WS1.Range("D:D")) Then WS1.Activate WS1.Range("A1").Select RowPos = WorksheetFunction.Match(WS2.Range("A1").Value, WS1.Range("D:D"), 0) Namae = WS1.Range("A" & RowPos).Value Selection.AutoFilter Field:=1, Criteria1:=Namae End If End If End Sub A1セルに1から順に数値を大きくしていくことですべての野菜についてオートフィルタを行うことができますね。
お礼
式を入れるだけで1,2,3・・・の方が野菜名よりも選択しやすいですね。 シート2にマクロを入れて実際にやってみたのですが、無反応・・・。 今使っているマクロとの組み合わせがだめなのでしょうか。 難しい、ちょっと勉強してみます。 ありがとうございました。
関連するQ&A
- Excelのフィルターなんですが
A列 B列 1 りんご 2 みかん 3 すいか 1 りんご 2 みかん 3 すいか 1 りんご 2 みかん 3 すいか 上記の表があり、フィルターで1を選ぶ場合に自動マクロで記録すると Selection.AutoFilter Field:=1, Criteria1:="1" となります。これをC3に入力した数字を参照したいので Selection.AutoFilter Field:=1, Criteria1:=cells(1,3) としてみたのですが、うまくいきませんでした 下記のように選択されるようにしたいのですが、どうすればよいのでしょうか? A列 B列 1 りんご 1 りんご 1 りんご
- ベストアンサー
- その他MS Office製品
- マクロ オートフィルタで困っています。
マクロ オートフィルタで困っています。 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
- ベストアンサー
- その他MS Office製品
- オートフィルタ マクロについて
質問です。 オートフィルタで複数列を1つの条件で抽出したいのですが、教えてください。 たとえばA列が納品書No.・B列が受注No.・C列が商品No.なのですがすべて数字の為、出来ればInBox一回でA-C列を検索してほしいです。 指定納品書NO 受注NO 元品番 21812 3252608 77 21880 3307989 32B 22053 3389769 95414A 22050 3389770 67312H 22052 3389771 67312H 22050 3389773 67118H 以下の様なマクロを作ってみましたが、 A-C列全てに一致しないと抽出しないようです。 どなたかご教授いただけないでしょうか? マクロ '条件1 の設定 Dim 検索NO As Variant '抽出キーの入力指示 検索NO = InputBox("検索NOを入力てください。") 'キャンセルした場合の処理 If 検索NO = Empty Then Exit Sub End If 'オートフィルタがかかっていなかったらかける 'かかっていたら念の為一度解除し再設定 If ActiveSheet.AutoFilterMode = False Then Range("A2:O2").Select Selection.AutoFilter Else Selection.AutoFilter Range("A2:O2").Select Selection.AutoFilter End If Selection.AutoFilter Field:=1, _ Criteria1:=">=" & 検索NO, Operator:=xlAnd, Criteria2:=" " & 検索NO Selection.AutoFilter Field:=2, _ Criteria1:=">=" & 検索NO2, Operator:=xlAnd, Criteria2:=" " & 検索NO2 Selection.AutoFilter Field:=3, _ Criteria1:=">=" & 検索NO3, Operator:=xlAnd, Criteria2:=" " & 検索NO3 AutoFilterMode = False Application.ScreenUpdating = True End Sub よろしくお願いいたします。
- 締切済み
- Visual Basic
- マクロの動作するタイミング
こんにちは。 VBAに関して初心者です。宜しくお願い致します。 sheet1のB1でsheet名の一覧をドロップダウンから選択できるようにし、 sheet1A列に、選択したsheetのA列が表示されるようにしました。 そのA列をオートフィルターで「空白以外のセル」を表示していますが、 これをマクロを使って、常にオートフィルターを適用した状態にしたく ---------------------------------------------------------- Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Selection.AutoFilter Field:=1, Criteria1:="<>" Columns("A:A").Select Selection.Copy End Sub ---------------------------------------------------------- と、しました。 上記のマクロではB1で選択後、ダブルクリックするとA列の オートフィルターを適用し、その列をコピーする。 と言うことになります。 これを、ダブルクリックするのではなく、B1でsheet名を選択すると オートフィルターを適用するようにするには、どうしたらよいのでしょうか。 お願い致します。 WinXP Excel2003です。
- ベストアンサー
- オフィス系ソフト
- オートフィルタをかけるマクロ
A12からA50に表示されている内容でB列にオートフィルタをかけ、印刷をする というマクロですが、 Selection.Autofilter field:=2, Criteria1:=Range("A12") Activesheet.Printout を39回コピーし、"A12"の部分を"A13"............"A50"に変えていきました。 本当はもっとスッキリできると思うのですが、そこがまだよくわかりませんので どなたか教えていただけないでしょうか。 A列は必ず50までデータがあるとは限りません。 エクセル2003使用の初心者です。 よろしくお願いします。
- ベストアンサー
- その他MS Office製品
- 特定のセルをフィルタするマクロを作りたい
特定のキーワードが含まれるセルをフィルタするマクロを作りたいです。 使用環境はExcel2010です。 口頭ではわかりにくいので、画像を添付します。 添付画像のように、それぞれの人物名と点数が一覧になった表があります。 特定の名前の人で点数が一定以下の行をフィルターしたいのですが、毎回フィルターで名前を選ぶのが面倒なので、マクロの記録機能で下記のマクロを作成しました。 Selection.AutoFilter ActiveSheet.Range("$A$1:$C$7").AutoFilter Field:=2, Criteria1:="=鈴木", _ Operator:=xlOr, Criteria2:="=田中" ActiveSheet.Range("$A$1:$C$7").AutoFilter Field:=3, Criteria1:="<70", _ Operator:=xlAnd 上記のマクロで、「田中」と「鈴木」のみ、点数が70点に満たなかった行を抜き出しています。 しかし、他部署の人物も調査の対処に含めるため、E2:E7セルに調査したい対象の名前を入れ、自動的にセルに入力された名前でフィルタリングされるようにしたいです。 この際のマクロの記載方法を知りたいです。 *部署によって人数が異なるため、E2:E7セルに入力する名前がすべて埋まるとは限りません。 *実際の名前と点数は毎月新しいExcelブックで送られてくるので、フィルター用のExcelシートにコピーペーストで張り付けて使用予定です。 *記載されている名前や点数は例です。
- ベストアンサー
- Excel(エクセル)
- エクセルでのフィルタについて
エクセルのことで、教えてください。 1つのブックに、たくさんのシートがあります。 1枚は、印刷用シートでA1セルの数字によって内容を変更できるようになっています。 2枚目以降は1列目に1から45までの数字、2列目以降に文章があります。 で、2枚目以降の2列目を印刷用シートに図のリンク貼り付けしておいて、印刷用シートのA1セルの数字で、2枚目以降のシートをフィルタリングすると、印刷用シートの内容が変更するようにしています。 そのフィルタリングのために、以下のようなマクロを組んでいます。 a = Range("A1").Value Sheets("Sheet2").Select Selection.AutoFilter Field:=1, Criteria1:=a Sheets("Sheet3").Select Selection.AutoFilter Field:=1, Criteria1:=a Sheets("Sheet4").Select Selection.AutoFilter Field:=1, Criteria1:=a 以下シートの枚数だけ続く。 これだとこのマクロが実行完了するまである程度の時間を要するので、もう少し時間を短縮できるような記述に出来ないかというのがお聞きしたいことです。マクロの記録で作成したものを参考にしたのでこうなっているんですが、何かうまい方法があれば教えてください。
- ベストアンサー
- その他MS Office製品
- コンボボックスとオートフィルタの連動
データの件数が増えてきたので、コンボボックスで選択した項目を一発で表示させるマクロを組みたいと思います。 前提は以下の通りです。 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
- エクセルのマクロでフィルタを判別するマクロ
いつもお世話になっております。 エクセル2000で オートフィルタを使用した表があります。 やりたいことは以下の通りです。 AutoFilter Field:=1(一番左側のフィルタ)が、 なんらかのフィルタリングがされている (フィルタの▼が青い状態)のときはそのままで、 なにもフィルタリングされていない (フィルタの▼が黒い状態)のときは Selection.AutoFilter Field:=1, Criteria1:="<>#N/A", Operator:=xlAn を実行させたいのです。 どのようなマクロを記述すればいいか ご教示ください。 よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- 【マクロ】オートフィルター内の全データが削除される
こんにちは、質問させていただきます。宜しくお願いします。 [エクセル] 2007 [内容] オートフィルタをかけ任意のデータのみ消したいのですが 全てのデータが消えてしまいます。 [詳細] A1~C5までデータが入っているのもだと仮定します。 (実際には項目があってフィルタがきちんとかかるものとします。) A B C ----------------------- 1 ○ 2個 \10 2 △ 1個 \5 3 × 3個 \15 4 ○ 1個 \20 5 ○ 4個 \5 オートフィルタをかけA列を基準として「○」を選択します。 そして選択した「○」を含む行(1行・4行・5行)を削除し 2行・3行目が残るようにしたいです。 その一連をマクロにして処理したいのですが… 1行から5行のすべての行データが削除されてしまいます。 <マクロ作成> マクロを記憶する。 ↓ 手動でオートフィルタをかけ、「○」を選択して行を削除 ↓ マクロの記憶を終了。 ↓ マクロ文の削除する行範囲をA1からC5に書き換え ↓ マクロ実行 <マクロ作成文> Selection.AutoFilter Selection.AutoFilter Field:=1, Criteria1:="○" ActiveSheet.Range("A1:C5").Select Selection.Delete Shift:=xlUp ※エクセル2007のバージョンによっては選択した「○」のみ 削除されるPCもありましたので、何か設定があるのかな?と 思いましたが…解決しませんでした。 何か良い案があれば教えていただきたいです。 宜しくお願い致します。
- ベストアンサー
- その他MS Office製品
お礼
難しすぎてなんとなくしか仕組みを理解できませんでしたが すごいですね!シート名が出来ました。 使わせて頂きます。 ありがとうございました!感謝です。