セルの値が指定条件なら対象行を削除するマクロ

Question

ボタンクリックでプロシージャーが起動します。
そのマクロの中で以下の２つの処理を追加させたいです。
マクロの記述を教えてください。

Ａ～Ｆ列までデータが有ります。
１行目は項目で２行目からデータがあります。
行数は都度相違しますが10,000行はあります。

(1)
Ｆ列の値は標準で、ここが0の場合その行全体を削除します。
入っている値の例
-1234→削除しない
345→削除しない
12346→削除しない
0→削除する
セルの空白はぜったいありません。

(2)－１
Ｅ列の値は標準で英数字３ケタです。ところどころ空白があります。
Ｅ列の値が先頭７Ｂ以外は行全体を削除します。
７Ｂ１→削除しない
７Ｂ２→削除しない
７ＢＷ→削除しない
７７Ｃ→削除
４７Ｂ→削除
空白→削除

Ｆ列を優先なのでＥ列が７Ｂで始まっている行でも
Ｆ列が０なら削除となります。

(2)－２
(2)－１と同じでＥ列の値は標準で英数字３ケタです。
ところどころ空白があります。

Ｅ列の値が
先頭
７Ｂと７２以外
又は
ＣとＤと７Ｂ以外は
行全体を削除します。
のように(2)－１のように1条件ではなく２～複数になる。
それが1文字の場合、2文字の場合、3文字全部の場合がある
Ｆ列を優先なのは（２）－１と同じです。
条件例
・Ｃと７３以外
・ＣとＦと７２以外
・Ｇと７Ｖと８Ｄ以外
・Ｇと８８と８Ｄ５以外

以下の記述ですが、（１）は思ったとうり動作しましたが
●の部分が分かりません。
現在の記述では７ＢＢ以外は全部行削除されてしまいます。
（２）－１と（２）－２の対応のために
記述内で（２）－１と（２）－２を
書き換える事が出来るような記述にしたいです。

あと凄く処理が遅いので高速化もしたいです。
よろしくお願いします。

Sub test01()
'A～K列のデータにて
'E,F,H,I,K列を列削除する
Columns("E:F").Select
Selection.Delete Shift:=xlToLeft
Columns("F:G").Select
Selection.Delete Shift:=xlToLeft
Columns("G:G").Select
Selection.Delete Shift:=xlToLeft
'データがA～F列になりました。

With ActiveSheet 'アクティブなシートについて
x = .UsedRange.Cells(.UsedRange.Count).Row 'xに最終行を取得
For i = x To 2 Step -1 '最終行から2行目まで下から順に
'F列が"0"だったらその行を削除
If .Cells(i, 6) = 0 Then .Rows(i).Delete 
Next '繰り返し
End With
With ActiveSheet 'アクティブなシートについて
x = .UsedRange.Cells(.UsedRange.Count).Row 'xに最終行を取得
For i = x To 2 Step -1 '最終行から2行目まで下から順に
'E列の値の先頭文字が"7B"でなかったら削除（空白の場合も削除）
●If .Cells(i, 5) <> "7BB" Then .Rows(i).Delete 
Next '繰り返し
End With
End Sub

merlionXX · Accepted Answer

おはよう。
二日酔いのmerlionXXです。

見直してみました。
わたしのケアレスミスでした。
下から5行目の
.Range("A2:F" & j).Value = myW
で変数を間違えてます。
Layyさんがご指摘のとおり、j ではなく n にしなければいけません。

.Range("A2:F" & n).Value = myW

に訂正します。

merlionXX · Answer

今日の補足みました。
これ、わたしが教えたの？

> その状態のまま
> Sub エクセル6ファイル取込()を再度走らせます。

この段階で、Sheets("現在在庫")のセルがクリアされますよ。

> MsgBox "抽出した６ファイル用意されていますか？"

これでは「はい」しか選択できませんね？
だから、自動的に　Sub　エクセル6ファイル選択　がCallされますね。

ところが、Static を使ってるから、変数myCntはこのプロシージャーが終了しても保持されたままです。（６になってるはず）
したがって、
If myCnt >= 6 Then　で
MsgBox "６個のBOOKの転記が終了してます。"　となり
Exit Sub　でマクロが終了します。

エクセル6ファイル取込()を再度走らせるとは、そのBOOKを終了せずに、同じようなことをまた続けたいってこと？
それなら

Sub エクセル6ファイル選択02()
'エクセルファイルを選択します。6回行います。
'1番目のプロシージャーでCallされます。2回目に走ります。
    Dim ans As Boolean
    Static myCnt As Integer
    If myCnt >= 6 Then
        MsgBox "６個のBOOKの転記が終了してます。"
        myCnt = 0 '*ここでカウントを初期化
        Exit Sub
    End If
    ans = Application.Dialogs(xlDialogOpen).Show
    If ans Then
        myCnt = myCnt + 1
        Call 在庫データ6ファイル転記(ActiveWorkbook, myCnt)
    End If
End Sub

としたらどうなるかな？
試してないから責任もてませんが。（こんなことやったことないよ）

merlionXX · Answer

まだ松の内だから、明けましておめでとうございます。
1月は５日から仕事です。今日はお休みですが。

ANo7の補足を見ました。

> 02と03は　<>ですが
> 04は　=　です。

はい、その通り。
理由は分かりますね？
前にも説明したように高速化させるため、ワークシート上で不要行を削除するのはやめて、残す行のデータだけを２次元配列に取り込むようにしたからです。
trst02を同じように高速化させるなら、
「E列の値の先頭文字が"7B"でなかったら、E列が空白の場合も含め、その行を削除する」ということは、逆にE列の先頭2文字が"7B"だけを２次元配列に取り込めばいいってことだよね。
つまり、
If Left(myV(i, 5), 2) = “7B” Then
で、OKです。
> If Left(myV(i, 5), 1) = 7B Then　
ではだめです。
よく見比べてください。

> あと高速型test04の方で02,03に有る「E列が空白の場合も行削除」はどの部分になるのでしょうか？

もう説明の必要もないと思いますが、データを残す条件だけを指定すれば、わざわざ「空白の場合も行削除」を指示しなくても削除されるってわけです。
以上、今年最初のこども電話相談室でした。（笑）

layy · Answer

Application.ScreenUpdating = False
Application.ScreenUpdating = TRUE
この機能は覚えておくこと。
表示→カーソル移動→判定→物理的に消す→（消えた状態を）表示→カーソル移動
これを繰り返すだけで結構時間かかります。
（チカチカします。）
何でもかんでもこれ使うかというわけでなくて、
処理中に何が起きているか見なくてもいいレベルになったらこれを記載することでしょう。

あと、
右の列のどっかに「削除対象行は＝消の文字」としてあげたら、
あとはＤＥＬＥＴＥのコマンド発行しなくても、
並べ替えなりフィルタで不要行削除された状態と同じものは実現できるので、
実際にはそちらのが処理がもっと早かったかもしれません。

ゆっくり休んでください。

layy · Answer

.Range("A2:F" & j).Value = myW
のｊの値が６になっているからでは？。
"A2:F6"分しか貼り付けていない。

貼り付け用に残っているのはｎ行もあるから、
.Range("A2:F" & n).Value = myW
かな？。

あとは本人の確認待ちで。

merlionXX · Answer

> 03は300行残りました。
> 04は４行しか残りません。

それは困った！
これからXmasEveのパーティなんです。もういかなくっちゃ。ごめん。
とりあえずTEST03でしのいでいてください。
あと気づいたことがとがあったら教えてください。

merlionXX · Answer

> はい。そのとうりです。
> 私のＰＣを見られているみたいです。

そうじゃなくて、普通は英数のデータってたいてい半角でしょ？
かわいい、かわいいgx9wxちゃんは普通じゃないと言われるとそれまでなんだけど、コードを書くに当たって、半角か全角か、あるいは混在するのか、それによって書き方は変わるんじゃないかぐらいは想像できるよね？
だから質問の時には手を抜かず、ちゃんと書いてほしいのです。

> ですが、やはり２～３分は待たないといけません。

以前のはどれくらいかかってました？
無駄に二回ループしてたからもっとかかったんじゃないかな。
でもこんな二回ループ、2007年にわたしが書いてたんだ・・・・。

では高速化した（つもりの）コードです。
高速化の秘訣は、
一番時間のかかる大量の行削除はしない。
セルとデータのやりとりは極力減らす。
だから対象範囲を一旦、二次元配列に取り込んじゃう。
データ処理は配列内で完結させる。（行が削除されたような形のデータにしてしまう。）
シートをクリアして一度に貼り付ける。
な～んて知ったかぶりして、ぜんぜん早くなってなかったらお笑いですね。

以下のコードでどれくらいかかるか教えてください。
複数条件の判定方法が逆になってますから注意してください。

あそうだ、gx9wxちゃん、Merry Xmas !

Sub test04() 'Test03の高速化
　　Dim myV, myW
　　Dim x As Long, i As Long, n As Long, j As Long
　　Application.ScreenUpdating = False
　　With ActiveSheet
　　　　.Range("E:F,H:I,K:K").Delete Shift:=xlToLeft
　　　　x = .UsedRange.Cells(.UsedRange.Count).Row
　　　　myV = .Range("A2:F" & x).Value
　　　　ReDim myW(1 To x - 1, 1 To 6)
　　　　For i = 1 To x - 1
　　　　　　If myV(i, 6) <> 0 Then
　　　　　　　　If Left(myV(i, 5), 1) = "C" Or Left(myV(i, 5), 1) = "F" Or Left(myV(i, 5), 2) = 72 Then
　　　　　　　　　　n = n + 1
　　　　　　　　　　For j = 1 To 6
　　　　　　　　　　　　myW(n, j) = myV(i, j)
　　　　　　　　　　Next j
　　　　　　　　End If
　　　　　　End If
　　　　Next i
　　　　Application.Calculation = xlCalculationManual
　　　　.Range("A2:F" & x).ClearContents
　　　　.Range("A2:F" & j).Value = myW
　　End With
　　Application.Calculation = xlCalculationAutomatic
　　Application.ScreenUpdating = True
End Sub

layy · Answer

単純に考えると、
１００００行あるデータを条件１で検証し、条件２でまた検証するとなると２００００行のデータを操作していることになっているので遅い。２条件から４条件に増やすと倍遅くなるでしょう。

１行分操作するときに、条件１に合えばＬ列に〇、合わなければＬ列に×、条件２に合えばＭ列に〇、合わなければＭ列に×、こんな感じでＬ列が〇でＭ列が〇なら削除だ、ということで１００００行まで行えば操作した行は少なくなり、処理早くなると考えられます。

merlionXX · Answer

> Ａ～Ｆ列までデータが有ります。とお書きですが、提示されたコードを見ると、'E,F,H,I,K列を列削除した結果、Ａ～Ｆ列のデータになったようです。そういう理解でいいのですね？普通はそう言葉で書きますよ。また、アルファベットや数字を全角でお書きですが、実際のデータは半角なんじゃないですか？その前提で書かれたコードを修正すると以下のようになります。 Sub test02() '(2)－１です。　　Application.ScreenUpdating = False 　　With ActiveSheet 'アクティブなシートについて　　　　.Range("E:F,H:I,K:K").Delete Shift:=xlToLeft 'E,F,H,I,K列を列削除する　　　　x = .UsedRange.Cells(.UsedRange.Count).Row 'xに最終行を取得　　　　For i = x To 2 Step -1 '最終行から2行目まで下から順に　　　　　　If .Cells(i, 6) = 0 Then 　　　　　　　　.Rows(i).Delete 'F列が"0"だったらその行を削除　　　　　　Else 'F列が"0"でなかったら　　　　　　　　If Left(.Cells(i, 5), 2) <> "7B" Then 'E列の値の先頭文字が"7B"でなかったら　　　　　　　　　　.Rows(i).Delete '削除(空白の場合も削除) 　　　　　　　　End If 　　　　　　End If 　　　　Next '繰り返し　　End With 　　Application.ScreenUpdating = True End Sub Sub test03() '(2)－２です。　　Application.ScreenUpdating = False 　　With ActiveSheet 'アクティブなシートについて　　　　.Range("E:F,H:I,K:K").Delete Shift:=xlToLeft 'E,F,H,I,K列を列削除する　　　　x = .UsedRange.Cells(.UsedRange.Count).Row 'xに最終行を取得　　　　For i = x To 2 Step -1 '最終行から2行目まで下から順に　　　　　　If .Cells(i, 6) = 0 Then 　　　　　　　　.Rows(i).Delete 'F列が"0"だったらその行を削除　　　　　　Else 'F列が"0"でなかったら　　　　　　　　If Left(.Cells(i, 5), 1) <> "C" And Left(.Cells(i, 5), 1) <> "F" And Left(.Cells(i, 5), 2) <> 72 Then 'E列判定（下記参照）　　　　　　　　　　.Rows(i).Delete '削除(空白の場合も削除) 　　　　　　　　End If 　　　　　　End If 　　　　Next '繰り返し　　End With 　　Application.ScreenUpdating = True End Sub 'E列判定の条件例 '・Cと73以外左の先頭1文字がCでなく、かつ先頭2文字が73でないという意味ですか？ならば If Left(.Cells(i, 5), 1) <> "C" And Left(.Cells(i, 5), 2) <> 73 Then '・CとFと72以外 If Left(.Cells(i, 5), 1) <> "C" And Left(.Cells(i, 5), 1) <> "F" And Left(.Cells(i, 5), 2) <> 72 Then あとはご自分でもわかりますね。データ量が多いから時間はかかるでしょうね。配列に取り込めは高速化出来ますが、まずは上記の理解でいいかどうかを確認します。

layy · Answer

最初に列削除してますが

条件１の判定結果をＬ列に
条件２－１の判定結果をＭ列に

条件２－２の判定結果をＮ列に

最終的に削除するかの判定結果をＯ列に

まずはここまでやって判定の妥当性を確認します。

すべての行に判定でき、問題なかったらＯ列をみて削除


随時削除、再描画していることが遅くしていると思います。

処理経過を表示させないコマンドあり、参考。

先頭１文字、２文字の文字列判定はLEFT関数使います。

セルの値が指定条件なら対象行を削除するマクロ

おはよう。

この回答への補足

今日の補足みました。

この回答への補足

まだ松の内だから、明けましておめでとうございます。

この回答への補足

Application.ScreenUpdating = False

.Range("A2:F" & j).Value = myW

> 03は300行残りました。

この回答への補足

> はい。

この回答への補足

単純に考えると、

> Ａ～Ｆ列までデータが有ります。

この回答への補足

最初に列削除してますが

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング