• 締切済み

VBA 検索条件にヒットした行を削除

VBAのことで教えてください。 エクセルのsheet1の「L列」に複数のデータが含まれております。 その中に「ロングタイプ」、「ショートタイプ」、「無償」など沢山のワードがある中で、 アスタリスク記号を利用して、5パターンのワードを検索して、その検索条件に満 たしている行を削除したいのですが、コードがわかりません。 例えば・・・・・ ロングタイプA ショートタイプB ロングタイプB ショートタイプA 無償A 無償B キャンペーンA キャンペーンB もっと複数のワードがあるのですが、その中でいらないワードをアスタリスク記号 を利用して5つワードを検索し、その対象行を削除したいです。 例えばアスタリスク記号を利用して「*ロング*」「*ショート*」「*無償*」などロングと 入っているワードを検索かけて、行を削除する。 コードで回答して頂ければ、幸いです。 宜しくお願いします。

みんなの回答

  • eden3616
  • ベストアンサー率65% (267/405)
回答No.2

http://okwave.jp/qa/q8684309.html とほぼ同一の内容かと存じます。 オートフィルタ―ではなく、削除が目的と把握致しますので 上記回答のコードを削除用に改変致しましたので回答させて頂きます。 以下のコードを標準モジュールへ張り付けて コード内の以下の箇所を変更し、 '/////////////設定///////////// '条件設定(カンマ区切りで条件を指定) word = Split("*無料*,*ショート*,*ロング*", ",") '対象列設定(検索対象とする列記号を指定) tcol = "L" '////////////////////////////// 「条件削除」を実行してください。 検索条件はカンマで区切って複数指定できます 増やすことも、減らすことも出来ます ■VBAコード Sub 条件削除() '型宣言 Dim word As Variant, i As Long, j As Long Dim tcol As String '/////////////設定///////////// '条件設定(カンマ区切りで条件を指定) word = Split("*無料*,*ショート*,*ロング*", ",") '対象列設定(検索対象とする列記号を指定) tcol = "L" '////////////////////////////// '行数ループ For i = Range(tcol & Rows.Count).End(xlUp).Row To 1 Step -1   'フラグ初期化   flag = 0   '条件削除   For j = 0 To UBound(word)     If Range(tcol & i) Like word(j) Then       Rows(i).Delete       Exit For     End If   Next j Next i End Sub

  • tom04
  • ベストアンサー率49% (2537/5117)
回答No.1

こんばんは! オートフィルタで「含む」の3条件以上の場合は作業用の列を設けて その列でフィルタを掛ける方法が簡単だと思います。 (「含む」ではなく、「指定する値に等しい」場合は Excel2007以降でArray等を使用すれば可能です) ただこれでは何もお役に立てないので、一例です。 尚1行目が項目行で項目はA列から入っているとします。 Sub Sample1() Dim lastRow As Long lastRow = Cells(Rows.Count, "L").End(xlUp).Row Application.ScreenUpdating = False Range("M:M").Insert With Range(Cells(2, "M"), Cells(lastRow, "M")) .Formula = "=IF(OR(COUNTIF(L2,""*ロング*""),COUNTIF(L2,""*ショート*""),COUNTIF(L2,""*無償*"")),1,"""")" .Value = .Value End With If WorksheetFunction.CountIf(Range("M:M"), 1) Then Range("A1").AutoFilter field:=13, Criteria1:=1 '←「13」は作業列(M列)の列番号 Rows(2 & ":" & lastRow).SpecialCells(xlCellTypeVisible).Delete shift:=xlUp End If AutoFilterMode = False Range("M:M").Delete Application.ScreenUpdating = True End Sub ※ 行すべてを削除しています。 こんな感じではどうでしょうか?m(_ _)m

関連するQ&A

  • 【Excel VBA】条件つき行削除

    Excel2003を使用しています。 システムからCSVで落としたデータで、データの並び方に規則性があるので、それを利用して、不要部分のデータをマクロで削除できないかと思い、質問させていただきます。 A列に『累計』を含む文字があった場合、その行のD列が0だったら、その行より上の行のA列に『計上日』と入力されている行までを削除するということをしたいです。 下記でいうと、2~5行までを削除したいです。    A     B     C     D 1 2 計上日 3 4 5 累計                0 6 7 計上日 8 9 累計              1000 上記では、B列、C列には何も書いていませんが、実際はデータが入力されていたり、空欄だったりです。 D列が0の行を削除するコードはわかるのですが、さらに、条件が加わっても同じように処理は可能でしょうか? よろしくお願いします。

  • VBA フィルター条件について

    マクロの初心者です。 フィルターをかける際に指定の文章が含まれているものをのみを絞り込む方法を教えてください。 できれば、下記に例を記載するのでコードをコピーして使用できるように教えて頂けると嬉しいです。 【例】  A列 1ロングタイプ1 2ショートタイプ2 3無料タイプ 4ショートタイプ1 5ショートタイプ3 6ロングタイプ2 7有料タイプ1 8有料タイプ2 9ロングタイプ 10有料タイプ2 11ショートタイプ 12有料タイプ1 上記のようなデータある際に「無料」、「ショート」、「ロング」という言葉が入っているもの だけを検索かけれるようにしたいのですが、やり方がわかりません。 ためしに「*無料*」などしてやってみたのですが、3つ以上するとエラーがでてしまいます。 わかりづらかったらすいません。その場合は質問してください。 宜しくお願いします。

  • VBA アクティブ行の削除

    エクセルで、アクティブにしているセルの行のA列からL列のみを削除というマクロを組みたいのですが、どのように記述したらいいのでしょうか? アクティブなセルはA列~L列のどこにあっても、その行のA列-L列を削除というようにしたいです。 (例1) A1がアクティブだった場合、A1~L1が削除される (例2) B4がアクティブだった場合、A4~L4が削除される すみませんが、お分かりになる方がいましたらよろしくお願いいたします。

  • Excel VBA Sheet2で指定した条件でSheet1の行削除

    Sheetが2つあるExcelブックがあります。 Sheet2で検索条件(列とキーワード)を指定し、 この条件でSheet1を検索、 Sheet1で検索にヒットした行を行削除したいと考えています。 汎用性を高める為、Sheet2で指定する検索条件は可変とし、 検索対象とする列とキーワードは任意のものを必ず指定(""は無し)。 列&キーワードをひとつの検索条件として、 Sheet2の2行目~最終行までLoopしたいのです。 InStrを使用するなど、部分的には分かるのですが、 2つの条件を同時に変えながらLoopさせる方法が 色々試してみましたが、どうしても分かりません。 VBAに詳しい方、同様の処理をしたことがある方、 どうか助けてください!宜しく御願い致します。 [Sheet1] ・・・ 元データ     A   B   C ---------------------------- 1   あ ---------------------------- 2   い   該当 ---------------------------- 3   う       閉鎖 ---------------------------- 4   え   該当 ---------------------------- 5   お ---------------------------- [Sheet2] ・・・ 行削除する範囲とキーワードを指定。     A   B ---------------------------- 1   列   キーワード ---------------------------- 2   A   あ ---------------------------- 3   B   該当 ---------------------------- 4   C   閉鎖 ---------------------------- [求めている結果] 1, 2, 3, 4行目が削除される

  • VBA 条件の一致する行の特定のセルの削除について

    VBA初心者です。よろしくお願いします。 <sheet1>     A  B   C  D  E 1   1 1211 佐藤 10 100 2   2 1344  山田 25 150 3   3 1522 田中  5 80 4   4 1655  高橋 35 200 ・ ・ 100 100 3682 小林 40 300 <sheet2>    A   B 1 1344 2 この様な表があったとします。(見辛くてすみません) "sheet2"A1セルに入力した内容と同じ内容を"sheet1"のB列から検索し、その行のB~Eのセルを削除するにはどのようにしたら良いでしょうか? 例えば"sheet2で"「1344」と入力した場合、"sheet1"の「1344」のある2行目のB~Eのセルを削除するといった感じです。 削除後の空白は詰める必要はなく、マクロを記録させるボタンは"sheet2"に貼り付けます。 色々調べましたがどうにも分からない為質問させていただきます。 よろしくお願い致します。

  • EXCEL VBA 条件に合致しない行を削除したい

    超初心者です。どうか教えてください・・・m(_ _)m A列   B列   ・・・・・ 1234567  2345678 9876543  8765432  ・    ・  ・    ・ といった、表(数千行規模)があります。 A列とB列には7桁の数字があります。 A列とB列には途中ブランクのセルもあります。 A列またはB列のどちらかにも、 複数の範囲条件(数字)に合致しない行を削除したいです。 A列またはB列のどちらかに合致すればその行を残します。 複数の範囲条件(数字) (例)  1000000~1000009  2000100~2000199     ・     ・   十数個あります。 何卒、宜しくお願い致します。・・・m(_ _)m

  • エクセルまたはVBAで重複行を削除

    例えば、 A B 1 1 a 2 2 b 3 3 c 4 4 d 5 4 d 6 5 e 7 6 g 8 6 g といった表があるとします。 A列をキーに、昇順にされた一覧表です。 ここで番号が重複している行、この例では4行目と5行目、7行目と8行目がそうです。 こういった重複した行を検索して、行削除したいのですがどんな方法が可能でしょうか? 最終的にはVBAでのイベントになるでしょうが、それ以前にエクセルで前準備などしておくようなことは必要でしょうか? 表自体はかなり膨大な量のデータベースです。 よろしくお願いします。

  • VBA 結合行を削除したときに値を残したい

    以下の様な処理をVBAで行いたいのですが、セルの内容が消えてしまいます。どうすればよいか教えてください  A列に商品タイプがあり、B列に商品名が入力されている。  1つの商品タイプは複数の商品があるため、A列は数行単位で結合されている。  今、マクロで特定商品の行だけを別のシートにコピーしたい。    そこで、   シート全体をコピーし   コピーしたシート上で該当商品を含まない行を削除  するマクロを作成しました。  しかし、商品タイプの列が結合されているため、商品タイプの1行目を削除してしまうと  新しいシート上でA列が空欄になってしまいます。  該当行のみコピーすることも考えましたが、   商品を抜き出す表以外はそのままコピーする(この方が情報量は多い)ため、上記の方法   を考えました。    何か良い方法はないでしょうか。  よろしくお願い申し上げます 

  • EXCELで約6000行の中から同じ行を削除。

    EXCEL初心者です。 約6000行のデーターの中から同じ名前の行を削除する方法を 教えていただけないでしょうか?   A    B   c   d   e  1  ○ 2  ○ ← 削除  3  ○ ← 削除 4  △ 5  △ ← 削除 よろしくお願いいたします。

  • VBAで空白行を削除する

    VBAでリストの空白行を削除するための適当なコードを探しているのですがどんぴしゃのものが中々見つかりません。ご教授下さい。 ブックBのシートBのリストにはA2~AN●まで値が入っています。 別のブックAからVBAで値を取り出し貼り付けています。 いくつかの方法を試しました。 (1)ブックを開いたときに空白行を削除 Sub Auto_Open() '空白行を削除 Dim lRow As Long Dim i As Long lRow = Cells(Rows.Count, 1).End(xlUp).Row Application.ScreenUpdating = False For i = lRow To 2 Step -1 If Cells(i, 1).Value = "" Then Range(i & ":" & i).Delete End If Next i Application.ScreenUpdating = True End Sub 5分以上砂時計のままで結局終わりません。 強制終了させ再度ブックを開くと空白行は削除されているのですが、こんな動作では使うことができません。 (2)ブックAの値を貼り付けた後、空白行を削除し上書き保存する Sub エクスポート() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Range(Cells(5, 7), Cells(79, 46)).Select Selection.Copy 'コピー Workbooks.Open Filename:="\\パス\ブックB.xlsm" '貼り付け先ファイルオープン Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '貼り付け Dim lRow As Long Dim i As Long lRow = Cells(Rows.Count, 1).End(xlUp).Row Application.ScreenUpdating = False For i = lRow To 2 Step -1 If Cells(i, 1).Value = "" Then Range(i & ":" & i).Delete End If Next i Application.ScreenUpdating = True  '空白行を削除 ActiveWorkbook.Save '上書き保存 Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub (3)空白行を削除の部分は以下のコードも試しました Worksheets("SheetB").Range("A1").Select Set currentCell = Worksheets("sheetB").Range("A1") Do While Not IsEmpty(currentCell) Set nextCell = currentCell.Offset(1, 0) If Not IsEmpty(currentCell) Then 'カレントセルが空白でなく、 If IsEmpty(nextCell) Then '次のセルが空白のとき nextCell.EntireRow.Delete End If End If Set currentCell = currentCell.Offset(1, 0) Loop '空白行削除 宜しくお願い致します。

専門家に質問してみよう