エクセルVBA データ比較抽出について
- エクセルVBAを使用してデータの比較抽出を行いたいですが、うまく動作しません。
- マクロを組んでCriteria1とCriteria2の値を入力したいですが、上手く動かないです。
- 質問者はエクセルVBAでデータの比較抽出を行いたいが、条件の値を入力してもうまく動作しないと困っています。
- ベストアンサー
エクセルVBA データ比較抽出について・・・
いつも皆様には大変お世話になってます Worksheets("Sheet1").Select q = ListBox1 z = TextBox1 x = TextBox2 With Range("A1") .AutoFilter .AutoFilter Field:=2, Criteria1:=q .AutoFilter Field:=3, Criteria1:=">=150", _ Operator:=xlAnd, Field:=3, Criteria2:="<=160" というようなマクロ組んだのですが・・・実は、Criteria1:=">=150のところの150をTexitbox１をその下の160のところをTextbox2を入れたいのですが・・・ 色々やったのですが、うまく動かないのです；； 分かる方いらっしゃいましたら宜しくお願い致します。
- nanny
- お礼率55% (72/129)
- オフィス系ソフト
- 回答数1
- ありがとう数1
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
Wizard_Zeroと申します。 TextBox1、TextBox2のそれぞれの入力値を入れたいということでよろしいでしょうか？ Worksheets("Sheet1").Select q = ListBox1 z = TextBox1 x = TextBox2 With Range("A1") .AutoFilter .AutoFilter Field:=2, Criteria1:=q .AutoFilter Field:=3, Criteria1:=">=" & z, _ Operator:=xlAnd, Criteria2:="<=" & x Field:=3 を２回指定してたので、片方消しました。 あと、End With 無いですけど元のソースにはありますよね？
関連するQ&A
- VBAでオートフィルタを使った抽出がうまくいきませんのでどなたか教えて
VBAでオートフィルタを使った抽出がうまくいきませんのでどなたか教えてください。 A列、C列に日付が入っていて、A列は空白以外のセルを表示し、かつC列は、開始日、終了日で抽出したいのですが、うまくいきません。 With Worksheets("sheet").Activate 開始日 = ">=" & TextBox1.Text 終了日 = "<=" & TextBox2.Text .Range("A1:N200").AutoFilter Field:=1, Criteria1:="<>" .Range("A1:N200").AutoFilter Field:=3, _ Criteria1:=開始日, Operator:=xlAnd, _ Criteria2:=終了日
- ベストアンサー
- その他MS Office製品
- Excelでマクロを繰り返したい。
Excelでマクロを記録したら以下のようになりました このマクロを以下の条件で繰り返したいのですが。 Sub Macro1() '------------- '----------------------- ' Sheets("Sheet1").Select Selection.AutoFilter Field:=4, Criteria1:="=5*", Operator:=xlAnd, _ Criteria2:="<>5@*" Range("A3:A302").Select Selection.Copy Sheets("Sheet2").Select Range("A3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Sheet1").Select Range("A1").Select Selection.AutoFilter Field:=4, Criteria1:="=6*", Operator:=xlAnd, _ Criteria2:="<>6@*" Range("A3:A302").Select Selection.Copy Sheets("Sheet2").Select Range("B3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Sheet1").Select Selection.AutoFilter Field:=4, Criteria1:="=7*", Operator:=xlAnd, _ Criteria2:="<>7@*" Range("A3:A302").Select Selection.Copy Sheets("Sheet2").Select Range("A103").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Sheet1").Select Range("A1").Select Selection.AutoFilter Field:=4, Criteria1:="=8*", Operator:=xlAnd, _ Criteria2:="<>8@*" Range("A3:A302").Select Selection.Copy Sheets("Sheet2").Select Range("B103").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End Sub 条件＝ Field：は4～35位まで変動します 一連の動作をコピーして手作業で数字を変えてみたのですが プロージャが大きすぎてエラーになってしまいます。 何か良い方法は無いでしょうか？。
- ベストアンサー
- オフィス系ソフト
- Excel VBA 任意の日付から1週間分抽出
ＶＢＡ素人です。 シート１ Ａ Ｂ Ｃ Ｄ Ｅ １任意の日付 ２日付 曜日 内容 氏名 備考 ３ ４ ５ ６ このようなデータ入力です マクロ記録でオートフィルタを用い日付抽出をするマクロを吸出し、ネットで知った今日から前後4日間のマクロを入力し,改変し応用しようと考えたのですが、やはり素人には壁が高くうまいこと行きません。 皆さんに教えていただきたいのは以下の式 Range("A2:E2").Select Selection.AutoFilter ActiveSheet.Range("$A$2:$E$5").AutoFilter Field:=1, Operator:= _ xlFilterValues, Criteria1:=">=" & Date - 4, Operator:=xlAnd, Criteria2:="<=" & Date + 4 の↓この部分 xlFilterValues, Criteria1:=">=" & Date - 4, Operator:=xlAnd, Criteria2:="<=" & Date + 4 の & Date - 4 を、どう変更すれば Ａ１に入力した任意の日付に出来るのか？です。 きっと基本的な事だとは思うのですが、教えてくださいお願いします。
- ベストアンサー
- Visual Basic
- Excel VBAについて教えて下さい。
00というブックとテストというブックがあります。 00のデータを並び替え、一部変更し、テストのシート3へ貼付けを行いたいのですが、 うまく作動してくれません。以下に現在のコードを記載しましたので、ご指摘いただければと思います。 やりたいことは １．ブック”00”のシート00にて条件がF列が0、E列がHでソートをかけます。 ２．E列のHをすべて数字の1に変更します。 ３．今度は別の条件、F列が1、E列がH、D列が1でソートをかけます。 ４．E列のHをすべて消去します。 ５．すべて表示させA列からE列までのデータを、テストのシート３へ貼付けをします。 コピー＆ペーストは上手くいくのですが、肝心のソート+文字の変更+消去が出来ていません。 ネットを見ながら書いたコードで、VBAを勉強中です。 よろしくお願いします。 あと、この作業の前にブック00のB列にて昇順のソートをかけるというコードを追加したいのですが、 それについても教えていただけるとうれしいです。 よろしくお願い致します。 Private Sub Worksheet_Activate() Dim wb1 As Workbook Dim wb2 As Workbook Dim i As Long Application.ScreenUpdating = False Set wb1 = ActiveWorkbook Set wb2 = Workbooks.Open("C:\Documents and Settings\デスクトップ\メモ\00.xls", ReadOnly:=True) With wb2.Worksheets("00").Range("A1").CurrentRegion .AutoFilter .AutoFilter Field:=6, Criteria1:="=" & "0", Operator:=xlAnd .AutoFilter Field:=5, Criteria1:="=" & "H", Operator:=xlAnd .AutoFilter x = .Cells(Rows.Count, "A").End(xlUp).Row For i = 2 To x If Cells(i, 5) = "H" Then Cells(i, 5) = Replace(Cells(i, 5), "H", "1") End If Next i With wb2.Worksheets("00").Range("A1").CurrentRegion .AutoFilter .AutoFilter Field:=6, Criteria1:="=" & "0", Operator:=xlAnd .AutoFilter Field:=5, Criteria1:="=" & "H", Operator:=xlAnd .AutoFilter Field:=4, Criteria1:="=" & "1", Operator:=xlAnd .AutoFilter x = .Cells(Rows.Count, "A").End(xlUp).Row For i = 2 To x If Cells(i, 5) = "H" Then Cells(i, 5) = Replace(Cells(i, 5), "H", " ") End If Next i wb2.Sheets("00").Range("B1", .Cells(Rows.Count, 5).End(xlUp)).Copy wb1.Sheets("Sheet3").Range("K3").PasteSpecial wb2.Close False Range("A1").Select Application.ScreenUpdating = True End With End With End Sub
- ベストアンサー
- オフィス系ソフト
- エクセルVBAの一時停止後、 入力し再実行したい
エクセルVBAでオートフィルター実行後に一時停止し、オートフィルターで選んだエクセルシート上のセルに直接入力た後、マクロを再実行させたい。 Sub Macro1() ' ' Macro1 Macro ' マクロ記録日 : 2008/3/2 '製品コードより枠番を選ぶ Selection.AutoFilter Field:=12, Criteria1:="=?????1*", Operator:=xlAnd 'ここで一時停止し、エクセルシート上で入力した後、次の行を実行したい Selection.AutoFilter Field:=12, Criteria1:="=?????2*", Operator:=xlAnd 'ここで一時停止し、エクセルシート上で入力した後、次の行を実行したい Range("A1").Select End Sub
- ベストアンサー
- Windows XP
- ＥＸＣＥＬのＶＢＡを実行したら止まってしまいます。。。
お世話になります。 下記のマクロを作ってみたのですが、シート「読込」にコピーされたところまで確認できるのですが、その後マウスが砂時計になって、動かなくなってしまいます。オートフィルタを解除する部分を削って実行してみましたが、同じところで止まりますので、貼付のところに問題があるようなのですが、何がいけないのでしょうか？ また、なんかもっとスマートなプログラムになりませんでしょうか？ 宜しくお願いします。 Sub test() Sheets("Normal").Select Range("A2").Select Selection.AutoFilter Field:=1, Criteria1:=Sheets("読込").Range("B2"), _ Operator:=xlAnd, Criteria2:=Sheets("読込").Range("C2") Selection.SpecialCells(xlVisible).Copy Sheets("読込").Select Range("C3").Select ActiveSheet.Paste Sheets("Normal").Select Application.CutCopyMode = False ActiveSheet.ShowAllData Selection.AutoFilter End Sub
- ベストアンサー
- オフィス系ソフト
- Excel2003VBA
お世話になっております。 手作業マクロの記録で下記作業を行い、一部修正をして一度はうまく動作していたのですが １点 問題が御座いまして独自に色々試していたのですが、どうにもうまくいかないので どなたかご教授いただけませんでしょうか。 Sub ●●用() ' ' ●●用 Macro ' １２月１月の店舗を抽出し新しいブックに移動する。 ' Selection.AutoFilter Field:=3, Criteria1:="=12月", Operator:=xlOr, _ Criteria2:="=1月" Selection.AutoFilter Field:=8, Criteria1:="（店名）" Range("A4:W2076").Select Selection.Copy Sheets.Add ActiveSheet.Paste Application.CutCopyMode = False Worksheets("Sheet1").Select Worksheets("Sheet1").Move Workbooks("営業部まとめ.xls").Sheets("全件表示").Activate Selection.AutoFilter Field:=3 Selection.AutoFilter Field:=8 Range("A5").Select ActiveWorkbook.Save End Sub まず、 ＞Worksheets("Sheet1").Move ここだけあれば ＞Worksheets("Sheet1").Select こっちは必要ないでしょうか？ あと、上記の中で ＞ Worksheets("Sheet1").Select この部分なのですが、毎回「Sheet1」とは限らないので「アクティブシート」にしたいと思い色々試してみましたが 全てエラーとなり、結局元にもどしてしまいました。 ＞ Worksheets("Sheet1").Move あと出来ればこれも移動させた後でデスクトップに名前を付けて保存までしたいのですが どのようなコードを追加すればよろしいでしょうか。 宜しくお願い致します。
- ベストアンサー
- オフィス系ソフト
- 可視セルから結合セルへの貼り付けについて
お世話になります。 ユーザーフォームに期間を入力し、オートフィルタから可視セル をコピペしようと試みたのですが、貼り付け先が結合セルのため うまく出来ません。可視セルをひとつずつ貼り付けるしかないのでしょうか？ 仮にセルを一つずつ貼り付ける場合はどのようにコードを 書いたらよいでしょうか？ 以下コード Private Sub CommandButton1_Click() Dim 開始日 As Date Dim 終了日 As Date 条件 = Worksheets("sheet2").Range("C6") 場所 = Worksheets("sheet2").Range("A21") 開始日 = TextBox1 終了日 = TextBox2 If Worksheets("sheet1").AutoFilterMode Then Worksheets("sheet1").AutoFilterMode = False End If ScreenUpdating = False With Sheets("sheet1") .Range("A5").AutoFilter Field:=2, Criteria1:=">=" & TextBox1, Operator:=xlAnd, _ Criteria2:="<=" & TextBox2 '条件日付 .Range("A5").AutoFilter Field:=13, Criteria1:="=" & 条件, Operator:=xlAnd '条件 End With Range("A5").Select Range("A5:X1000").Sort Key1:=Range("A5"), Order1:=xlAscending, Header:= _ xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ SortMethod:=xlPinYin, DataOption1:=xlSortNormal Worksheets("sheet1").Range("A5").CurrentRegion.SpecialCells (xlCellTypeVisible) .Copy Worksheets("sheet2").Range("A21").Offset(-1.1).PasteSpecial , Paste:=xlPasteValues Range("C6").Select Application.CutCopyMode = False Worksheets("sheet1").AutoFilterMode = False ScreenUpdating = True End Sub
- ベストアンサー
- オフィス系ソフト
- Excel VBAについてご教ください
いつも、こちらのサイトをみながら、VBAを勉強させていただいているのですが、 今回、自分のやりたいことが見当たりませんでしたので、ご教示いただければと思います。 やりたいことは、 (1)「エリア１」にある名称ごとに同じBookの別シートに振り分け (2)各シートで「累計売上」順（降順）に並べ替え の２つの作業を同時に行いたいのです。 また、 (1)には、あらかじめ決まったシートが用意されているので、 そのシートの決められた範囲にデータを移したいのと、 データを貼り付ける前に、前に残っている前回のデータを削除してから、同場所に貼り付けを行いたいです。 ちなみに、エリアが3つあるので、シートも3枚あります。 自分でも、いろいろとやってみて、 下記のようなコードを書いたのですが、あまりにも重くて、動きがわるかったため、 シンプルかつ、軽やかに動くコードの書き方をお教えいただければと思います。 よろしくお願いいたします。 Sub Macro2() Application.ScreenUpdating = False With Worksheets("元データシート") .Range("A5").AutoFilter _ Field:=9, _ Criteria1:="京前", Operator:=xlAnd .Range("F4：P65500").Copy _ Worksheets("前 品別").Range("AJ5") .AutoFilterMode = False .Range("A5").AutoFilter _ Field:=9, _ Criteria1:="京中", Operator:=xlAnd .Range("F4：P65500").Copy _ Worksheets("中 品別").Range("AJ5") .AutoFilterMode = False .Range("A5").AutoFilter _ Field:=9, _ Criteria1:="京後", Operator:=xlAnd .Range("F4：P65500").Copy _ Worksheets("後 品別").Range("AJ5") .AutoFilterMode = False End With Application.ScreenUpdating = True MsgBox "各地区シートにデータを振分けました。" End Sub 【元データの形式は以下のような形になってます。】 A B C D E F G H I J ４ コード S番号 S名称 S名 月間個数 月間売上 累計個数 累計売上 エリア1 エリア2 ５ 4237 4025 AAA あああ 3 150 7 350 京後 後A ６ 6769 4025 AAA いいい 2 100 5 250 京中 中B ７ 3453 4028 BBB ううう 5 50 5 50 京後 後C ８ 4252 4029 CCC えええ 1 110 9 990 京前 前A ９ 3564 4027 DDD おおお 0 0 8 80 京前 前A １０ 8035 4022 EEE かかか 1 30 2 60 京中 中B １１ 9225 4026 EEE ききき 2 40 3 60 京後 後A 以下5000行ぐらいデータが続きます。
- ベストアンサー
- オフィス系ソフト
- 下記マクロの意味を教えてください。
Sub 済() With Worksheets("管理表") If .AutoFilterMode Then .AutoFilterMode = False End If Range("O7:P7").Select Selection.AutoFilter Selection.AutoFilter Field:=1, Criteria1:="=*済*", Operator:=xlAnd ActiveWindow.SmallScroll Down:=-12 Range("A1").Select End With End Sub よろしくお願い致します。
- 締切済み
- その他（プログラミング・開発）
お礼
早速のお返事ありがとうございます 試してみましたが ばっちり動きました＾＾ End With 付けてます... 書き忘れちゃいました (テヘ また 色々と宜しくお願いしますね。