• ベストアンサー

excel マクロ 特定の文字列を含まない行を削除したい

あるフィールド(例えばA列)にレコード長6桁で次のようなデータがあるとします。 10000 151692 621500 10000 999999 131700   ・   ・   ・ で、 10000を含むレコードのみ残してあとのレコードは削除したいです。 レコード数が多いのでAutoFilterしてCopy&PasteですとPC悲鳴あげました。 できれば順序は保持したいですが、ソートをつかっても構いません。 また今回は6桁の固定長ですので、5桁以外の行を選択削除してもいいかも知れません(本来は010000の6桁)。 が、そうでない場合も含めて、ご教授下さい。 ソートして手動で消せばいいんですが、全体のマクロの中の一部として組み込みたいので。 自分以外の人も使うので、Pen200くらいのPCでも悲鳴あげない方法を最終的には優先したいです。 accessなら単に10000のクエリで吐き出せばすむ話なんでしょうけど…。

  • takkk
  • お礼率54% (18/33)

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

  • ベストアンサー
  • newleaf
  • ベストアンサー率14% (1/7)
回答No.3

こんばんは。 MSクエリはエクセルのシートがデータベースのテーブルのように構成されていればクエリをかけることが出来ます。VBAではODBCドライバとしてエクセルドライバを使ってアクセスするようになります。具体的なコードまでは記述しませんがクエリをかけるのも一つの手と思われます。

その他の回答 (2)

  • ja7awu
  • ベストアンサー率62% (292/464)
回答No.2

> 10000を含むレコードのみ残してあとのレコードは削除したいです。 この条件から「含むレコード」ということですので、 010000、10000、910000、100009 は、全て残るとすれば 次のコードで、如何でしょうか。 Sub DelRows() Dim Rwe As Long Dim R As Long Const Col = "A" ' ←----- 検索対象列名を指定 Application.ScreenUpdating = False Rwe = Range(Col & 65536).End(xlUp).Row For R = Rwe To 1 Step -1   If InStr(CStr(Range(Col & R).Value), "10000") = 0 Then     Rows(R).Delete   End If Next Application.ScreenUpdating = True Beep End Sub

  • eipu
  • ベストアンサー率39% (25/64)
回答No.1

一番速度は期待できない方法ですが とりあえず、Do~Loopを使う方法を。 データはA列に抜けなく存在するものと仮定して作ってます。 Sub 行削除() Dim i As Long Application.ScreenUpdating = False i = 1 '検索開始行 Do Until Cells(i, 1).Value = "" If Cells(i, 1).Value <> "10000" Then Cells(i, 1).EntireRow.Delete i = i - 1 End If i = i + 1 Loop Application.ScreenUpdating = True End Sub

関連するQ&A

  • 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 による特定Recordの抽出

    VBAの初心者です。 各コマンドの意味もよく理解してないため、原因が判りません・・・。 ■特定情報を抽出するVBAの結果が合致しません。  ・Record数が「5000件」あるExcelFileから、Field:3に「1」が入力されているRecordを抽出するVBAを作りました。  ・ExcelsheetでFilterにより抽出するとField:3には「1」が「839件」入力されています。   しかし、実際に作成したVBAを走らせてみると「800件」しか抽出できません。 ■下記が作成したVBAです。 -------------------------------------------- 1)Private Sub task_Select2() Range("F1").Select Selection.AutoFilter Field:=6, Criteria1:="=1", Operator:=xlAnd Rows("3:5503").Select Range("B3").Activate Selection.Delete Shift:=xlUp Selection.AutoFilter Field:=6 ActiveWindow.LargeScroll Down:=-13 Range("B1").Select End Sub 2)Private Sub backup_task2() 'バックアップ用コピー処理 Dim Model As String, fName As String Model = ActiveSheet.Name fName = Model & "_wo" Worksheets(Model).Copy After:=Worksheets(Model) ActiveSheet.Name = fName Worksheets(Model).Activate End Sub 3)Private Sub task_Select3() Selection.AutoFilter Field:=3, Criteria1:=">1", Operator:=xlAnd Rows("3:10000").Select Range("B3").Activate Selection.Delete Shift:=xlUp Selection.AutoFilter Field:=3 ActiveWindow.LargeScroll Down:=-25 Range("B1").Select End Sub 4)Sub A_Main_task() '動作用メイン処理 Application.Run "backup_task" Application.Run "task_Loop" Application.Run "CommentMix" End Sub 5)Private Sub backup_task() 'バックアップ用コピー処理 Dim model As String, fName As String Model = ActiveSheet.Name fName = Model & "_copy" Worksheets(Model).Copy After:=Worksheets(Model) ActiveSheet.Name = fName Worksheets(Model).Activate End Sub -------------------------------------------- 1)でField:6に情報が入力されてないRecordを削除。 3)でField:3に「1」以外が入力されているRecordを削除。 ●1)の「Rows("3:5503").Select」でRecord「5000件」なら問題ないと思いましたが、   1)の結果は「4770件」でした。(5000件になると思ったのですが・・・) ・5000件以上のRecordを処理させようと思い、「Rows("3:5503").Select」の範囲を単純に増やしても1)の結果が減ってしまいます。 ◎Record数が「2700件」程度の情報は問題なく目的数の情報を抽出できました。 ●来週18日の月曜日中になんとか作成したい資料なのです。   お手数ですが宜しくお願いします。

  • エクセルのマクロ

    現在エクセルにてデーターの分析などをおこなっています。 そこで1つ質問ですがオートフィルターをした後のベスト10のデーターをコピーできないでしょうか? Sheets("シート名").Select Range("J5").Select Selection.AutoFilter Field:=10, Criteria1:=">=500", Operator:=xlAnd Range("A5:R2384").Sort Key1:=Range("Q5"), Order1:=xlDescending, Header:= _ xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ SortMethod:=xlPinYin, DataOption1:=xlSortNormal ActiveWindow.SmallScroll ToRight:=-4 Range("B5:R15").Select Application.CutCopyMode = False Selection.Copy Sheets("データーシート3").Select Range("B5").Select ActiveSheet.Paste この様にやっているのですが Criteria1:=">=500"の部分が変動する為に、表示されるデーター数がバラバラです。 たえずどんな条件でオートフィルターをかけても10件コピーできる方法はないでしょうか?

  • エクセルマクロで隣のシートへ値貼付け

    取引先コードを指定すると、 ワークシート1の表でオートフィルターにより該当する取引先を抽出し、 それを隣のワークシート2へ値貼り付けようとしますが、上手くできません。 通常の貼付けでは、計算式などがずれるため、値貼付けにしたいと思っています。 通常の貼り付けはうまくいくのですが、値貼付けをしようとすると、できません。 値貼付けの記述をどう改善すればいいでしょうか。 宜しくお願い致します。 (1)オートフィルターをコピー+通常の貼り付け With Worksheets(1).Cells(3, 20) .AutoFilter Field:=20, Criteria1:=当月取引先 .CurrentRegion.SpecialCells(xlVisible).Copy Worksheets(2).Cells(9, 1) .AutoFilter End With (2)オートフィルターをコピー+値貼り付け With Worksheets(1).Cells(3, 20) .AutoFilter Field:=20, Criteria1:=当月取引先 .CurrentRegion.SpecialCells(xlVisible).Copy Worksheets(2).Cells(9, 1).pastespecial paste:=xlpastevalues .AutoFilter End With

  • 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 というエラーです。 何が悪いのか分かりません・・・。 分かる方いましたらご教授ください。よろしくお願いします。

  • エクセルマクロ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 これ、担当者の抽出を自動でなんとかなりませんか?

  • Excelマクロ オートフィルタ可視領域の特定部分をコピー

    何方か、回答をお願いします。 下記もマクロは 、B列:C列(B1:C1はタイトル)をオートフィルタに掛けて フィルタに掛かった一番上のデータをコピーして貼り付けているマクロですが。 やりたいことは、B1:C1のタイトルとフィルタに掛かった可視領域の一番上の データ(オートフィルタに引っかからないでデータが無い場合も有り)をコピー して貼り付けたいのですがどの様なコードを書けば良いのでしょうか。? Sub フィルタ() Range("B1:C1").Select Selection.AutoFilter Selection.AutoFilter Field:=2, Criteria1:=">=1e-6" Range("B1").CurrentRegion.Select On Error Resume Next Selection.SpecialCells(xlCellTypeVisible).Areas(2).Rows(1).Select Selection.Copy Range("K15").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.AutoFilter End Sub

  • 追加クエリでテーブル全体を指定したまま条件を追加したい

    ACCESS2000を使ってます。 追加クエリでレコード追加の元となるテーブル全体を選択してます。 クエリのフィールド:テーブル名称.*と指定していますが、テーブルに追加する条件として、西暦4桁が格納されている「NENNDO」フィールドに2006だけのレコードを追加したいです。 クエリのデザインでフィールド:テーブル名称.*と指定されている状況で「NENNO」フィールドを追加して抽出条件に2006を指定して実行すると「出力先が重複しています」と表示されます。 追加クエリの対象テーブルが沢山あって、レコード追加先がOracleとなっているのでテーブルを削除せずにACCESSの削除クエリと追加クエリでレコードの作業したいと思っております。 フィールド:テーブル名称.*としたまま、テーブルに追加する条件だけを設定する方法をご教授願います。 (フィールドは、*ではなく、フィールド全てを1つづつ指定しないといけないのでしょうか?)

  • Access2013短文の先頭から5文字分を削除

    Access2013 フィールド(短いテキスト)に短文(30文字ほど)が入力してあります。 この短文の先頭から5文字分を削除する方法を教えて下さい。 更新クエリかと思いますが、『レコードの更新』の欄になんと記入したらよいでしょうか。 宜しくお願いします。

  • テーブル2の単語の行を削除にはどうすればいい?

    アクセスです。 テーブル1には、tango テーブル2には、単語 というフィールドがあります。 テーブル1とtangoとテーブル2の単語を線で繋いで テーブル1のtangoと同じ値のテーブル2の単語の行を消したいのですが どういうクエリを作ればいいのでしょうか? 画像の状態 DELETE [テーブル1].tango, [テーブル2].単語 FROM テーブル1 INNER JOIN テーブル2 ON [テーブル1].tango = [テーブル2].単語; をやろうとすると 削除するレコードを含んだテーブルを指定してください となります。 「削除するレコードを含んだテーブル」は、テーブル2なのですが どこでテーブル2と設定すればいいですか? プロパティシートを見ても、テーブルを設定する場所がわかりませんでした。 レコードの削除に、 Whereとfromがありますが fromは選択できません。 この状態で、テーブル2の単語の行を削除にはどうすればいいですか?