- ベストアンサー
エクセルでの自動抽出がうまくいかない！
- エクセル２０００で自動抽出機能を使用しても、最初の行の項目だけが重複して抽出されてしまいます。この問題を解決する方法はないでしょうか？
- 自動抽出の方法はデータセルを指定してデータ→フィルタ→フィルタオプションの設定→選択範囲内をデータのセルに指定し、指定した範囲を抽出先のセルに指定します。さらに、重複するレコードは無視するオプションにチェックを入れる必要があります。
- 上記のマクロは、「商品名の集計」という名前のマクロであり、特定の範囲から重複を削除して別のセルにコピーする機能を持っています。
- kogorou100
- お礼率77% (59/76)
- オフィス系ソフト
- 回答数1
- ありがとう数1
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
関連するQ&A
- inputboxではセル番地が指定できず困っています。
EXCEL2000のVBAで、フィルターオプション機能を自動化したいのですが、 抽出先が変動するので、inputboxでセル番地を選択しようとすると、セルを選択することができず、自分で「A1」などと入力すると、きちんとA1に抽出結果が出てくるのですが、自分でセル番地をinputboxに入力するのではなく、マウスでセル番地を指定したいのですが、どのような方法をすればよかったでしょうか? よろしくお願いします。ちなみ作ったVBAは以下のとおりです。（複数の表から同じ条件で抽出し、inputboxで指定したセル番地に抽出結果を出し、その右側に続けて抽出結果を貼り付けていくという感じで作っています） Sub 抽出() Dim Shouhin1 As String Dim Shouhin2 As String Dim Shouhin3 As String Shouhin1 = InputBox("抽出先を指定してください") Shouhin2 = "d" & Mid(Shouhin1, 2, 5)’二つ目の表の抽出先を指定 Shouhin3 = "g" & Mid(Shouhin1, 2, 5)’３つ目の表の抽出先を指定 Sheets("抽出先").Select Sheets("データ").Range("A5:c44").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Sheets("データ").Range("B1:B2"), CopyToRange:=Range(Shouhin1), _ Unique:=False Sheets("データ").Select Sheets("抽出先").Select Sheets("データ").Range("d5:f44").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Sheets("データ").Range("B1:B2"), CopyToRange:=Range(Shouhin2), _ Unique:=False Sheets("データ").Select Sheets("抽出先").Select Sheets("データ").Range("g5:i44").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Sheets("データ").Range("B1:B2"), CopyToRange:=Range(Shouhin3), _ Unique:=False End Sub
- ベストアンサー
- オフィス系ソフト
- エクセル2003 条件抽出したデータを切り取り別シートへ貼り付け
シート1にあるデータから3個のキーワードで抽出したデータを切り取り、シート2に貼り付ける方法を教えてください。 今までは抽出する条件のキーワードが２個以下だったので、オートフィルタのオプションで抽出したデータをコピーしてシート2に貼り付け、シート1で可視セルを選択して削除という方法をとっていました。 今回、条件にするキーワードが３個になったので、フィルタオプションの設定で、シート2のＡ1からＡ4にキーワードを入れて、検索条件範囲を指定してデータを抽出したので、今までの方法が使えなくなってしまいました。 参考までに、↓こんな感じです。 Sheets("Sheet2").Select Range("A1") = "条件" Range("A2") = "キーワード１" Range("A3") = "キーワード２" Range("A4") = "キーワード３" Sheets("Sheet1").Cells.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _ Range("A1:A4"), CopyToRange:=Range("A6"), Unique:=False
- 締切済み
- オフィス系ソフト
- 条件にマッチする行を抽出するVBAを教えてください
アイデア、またはVBAプログラムの例を教えていただきたく、質問させていただきます excelで、添付画像のようなリスト管理表を作っています。 リストは600行近くになります。 やりたいことは、D3またはE3に商品名または保管庫を入力すると、リスト内から、合致する行だけが抽出される、というもの。 D3とE3は、どちらか片方にのみ条件が入る。D3とE3の内容を変更するとリアルタイムで抽出結果も変更されるようにしたい。 触る人が初心者なので、難しい作業を一切せずに、D3またはE3を打ちかえるだけで必要な項目だけのリストとなり、印刷するだけでいいようにしたいわけです。 本来ならオートフィルタですればいい話ですが、どうしてもD3という離れたセルの入力内容で抽出したいのです。 VBAでなく、D3のセル内容を使ってD8～のオートフィルタが行えるなら、それが一番理想です。 が、自分でやってみた限りはできませんでした。 フィルタオプションならどうかとやってみたところ、一回目は抽出できました。しかし、D3またはE3の条件を変更しても、リアルタイムで抽出結果が切り変わらない。 フィルタオプションの抽出結果を別のセルに出せばいいのですが、そうすると無駄な情報が残り、ただ印刷しただけでOK・・というわけにいきません。（印刷範囲を区切るとかでなく、シートの見栄えが必要な情報だけにならないと…扱う初心者が混乱します） 自分なりには、VBAにより、 D3・E3のセル内容が書き換わったらフィルタオプションの抽出結果をいったん同シートの別セルに出し、抽出結果部分だけを別のシートにカット＆ペースト成形。そのシートを印刷させればよい。 という考えになりましたが、やってみたら、なぜか別のブックに同じものが形成され、抽出した結果だけ単独のデータにできません。 そもそももっと良いアイデアがあればそれをおしえていただきたい。 あるいは、VBAで目的達成できるように問題点をご指摘ください。 一応、プログラムを書いておきます ■添付画像のデータが入っているシート（『一覧』という名前のシート）内コード Private Sub Worksheet_Change(ByVal Target As Range) ' If Target.Column = 4 Then If Target.Row >= 3 And Target.Row <= 3 Then Call Filter Call copy End If End If End Sub ■サブルーチンFilter() 標準モジュールに記載 Sub Filter() ' Filter Macro 'フィルタオプションを使って同シート内「D1100」以降に抽出結果を出します ActiveWorkbook.Worksheets("一覧").Select '一覧表はD7～F1000。検索条件はD2～F３までの範囲に名前を付けたもの Range("一覧表").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "検索条件"), CopyToRange:=Range("D1100"), Unique:=False Range("A1").Select End Sub ■サブルーチンcopy() 標準モジュールに記載 Sub copy() ' ' copy Macro ' '抽出された内容（45行目～100行目まで）を別のシートにコピーします ActiveWorkbook.Worksheets("一覧").Select Rows("45:100").Select Selection.Cut ActiveWorkbook.Worksheets("抽出結果").Select Rows("4:4").Select Selection.Insert Shift:=xlDown Range("A1").Select End Sub
- ベストアンサー
- 経営情報システム
- 重複抽出マクロ
winxp he sp3, excel2003 AB DE: 銘柄コード（4桁固定）銘柄名 一体です。 1.やりたい事 ABとDEが、重複している場合、下記の様に、FGHに記述するマクロです。列が揃ってなくて、見にくいですが。 下記重複抽出マクロではNGです。コメントお願いします。 A B C D E F G H 3864 三菱製紙 0.15 3865 北越紙 3865 北越製紙 0.15 3865 北越製紙 0.15 4224 ロンシール 4531 有機薬 0 4530 久光製薬 0.45 4531 有機薬 7968 田崎真珠 0.15 4531 有機薬 0 4614 トウペ 4534 持田製薬 0.15 7968 田崎真珠 7958 天馬 0.15 8091 ニチモウ 7968 田崎真珠 0.15 8113 ユニチャ 0.9 8114 デサント 0.15 Sub 重複抽出() Rows(1).Insert Range("A1:e1").Value = [{1,2,3,4,5}] Range("IV2").Formula = "=COUNTIF(A:A,d2)>0" Columns("d:e").AdvancedFilter _ Action:=xlFilterCopy, _ CriteriaRange:=Range("IV1:IV2"), _ CopyToRange:=Range("f1:h1") Range("IV2").Clear Rows(1).Delete End Sub よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- ＥＸＣＥｌセルの値でフィルター抽出したい
windows10,microsoft365使用の超初心者です。 Sub セルの値でオートフィルターで抽出しその行を削除したい() Range("D8").AutoFilter Field:=6, Criteria1:=Range("Ｆ4").Value, Operator:=xlAnd End Sub このコードでやっても、うまく抽出してくれません。 どうして出来ないのかわかりません。ご教示よろしくお願いいたします。 セルＦ4は、表示は「６月２０日」数値は４４００２です。 セルＤ８は、表示は「令和２年６月分」で数値は４４００２です。
- ベストアンサー
- Visual Basic
- ＥXcelオートフィルタのオプション設定で条件として変数をマクロで組むには？
オートフィルタ機能を使い、指定期間内のデータを抽出するようにマクロを組みたい。指定期間が一定ではないので変数を設定したいのですがうまくいきません。下記はマニュアルで入力したものをマクロに記録したものです。指定期間は他のBookのセルに入力画面として設けてあります。例えばBook2／B1(開始)～B2(終了)。 Range("A1").Select Selection.AutoFilter Selection.AutoFilter Field:=1, Criteria1:=">=2005/8/21", Operator:=xlAnd _ , Criteria2:="<=2005/9/20" Range("C1").Select End Sub
- 締切済み
- オフィス系ソフト
- ＥＸＣＥＬマクロ セルに入力したシート名から参照
よろしくお願いします。 複数のシートがあり、それぞれ 1109,1110,1111,1112,1201,1202,1203,1204,1205 と名前がついています。 それぞれのシートには月毎のデータが入っています。 Sub Macro1() Columns("F:J").Select Selection.ClearContents Sheets("1205").Columns("A:E").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("C4:E5"), CopyToRange:=Range("F2:J2"), Unique:=False End Sub ↑のマクロをSheet3で作りましたが、4行目の「Sheets("1205")」の1205の部分を可変で作れればと 思っています。Sheet3のC3セル内に入力したシート名（1109や1203等）でフィルタ出来ると助かります。 どうぞよろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- 重複しないレコードを抽出するとオートフィルタの矢印が消える
リストを作成しています。 B列に氏名が入っています。その他C列には地域、D列には分類などそれぞれのデータが入力してあり、オートフィルタで抽出できるようになっています。 ここでB列の重複しない人の名前をAF列に抽出・転記したマクロを作ったのですが、マクロが動作すると同時に、今まであったオートフィルタの矢印も消えてしまいます。 重複しない人の名前を抽出・転記したあとも、今まで通りオートフィルタの矢印（機能）を表示するにはどうしたらいいのでしょうか。 Private Sub Workbook_Open() With Worksheets("顧客管理表") .Columns("B").AdvancedFilter _ Action:=xlFilterCopy, _ CopyToRange:=.Columns("AF"), _ Unique:=True .EnableAutoFilter = True End With End Sub いろいろ試したのですが、ダメでした。よろしくお願い致します。
- ベストアンサー
- オフィス系ソフト
- エクセル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）からペースト です。 最終的にボタンにしてツールバーに常駐させるのですが、ボタンはシート数と同じ１２個 作るつもりです。 （もちろん１個ですめば尚理想的なのですが） 指導の程、宜しくお願いいたします。
- ベストアンサー
- その他（プログラミング・開発）
- Excel フィルタオプション マクロ
＜Excel2013＞ フィルタオプションで抽出条件を加工し 別シート(抽出結果）に抽出したい。 検索条件で「文字を含む」の場合「＝”＝＊"」など 抽出記号入力するのが分からない人の為に、 検索したい文字だけ入力してVBAで加工して データを抽出したいのですが、上手く加工出来ません。 どうかお知恵をお貸し下さい！ ◎例題（実際は1000件位横に広いデータです） 【シート名：青森】 住所 処理No. 青森県青森市南町・・・ 10 ・ 青森県五所川原市北町 10 【シート名：秋田】 住所 処理No. 秋田県大館市北町・・・ 20 ・ 秋田県秋田市栄町・・・ 10 【シート名：抽出結果】 Ｃ2 Ｄ2 F2 G2 検索条件 抽出シート 住所 抽出シート 住所 秋田 栄 ＜抽出実行ボタン押下＞ ★検索条件：シート＝秋田 and 住所に『栄』を含むデータを抽出 同シート【Ａ7セル】を基準に抽出データを表示 Sub 抽出() Dim Sh As Worksheet ’* Set Sh = Sheets("抽出結果") Sh.Rows("7:7").Select Range(Selection, Selection.End(xlDown)).Select ' Sh.Range("A7").Select ★検索条件範囲：E2／F２へ加工した条件を設定 '** 抽出条件 If Sh.Range("C2").Value <> "" Then Sh.Range("F2").Value = "=” & Sh.Range("C2").Value End If If Sh.Range("D2").Value <> "" Then Sh.Range("G2").Value = "=”&"=＊" & Sh.Range("D2").Value & "＊" End If ’* Select Case Range("C2").Value Case "青森" Sheets("青森").Range("1:cx2000").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("F1:G2"), CopyToRange:=Range("A7"), Unique:=False Case "秋田" Sheets("秋田").Range("1:Cx2000").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("F1:G2"), CopyToRange:=Range("A7"), Unique:=False End Select End Sub
- 締切済み
- Excel（エクセル）
お礼
ありがとうございました。できました。タイトルラベルでもやったつもりでしたが指摘をうけ再度行ったところうまくいきました。助かりました。
補足
回答ありがとうございます。Ｄ８はタイトルではありません。タイトルはありません。Ｄ７をタイトルラベルとしてもう一度やってみます。