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

質問

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

Ａ～Ｆ列までデータが有ります。
１行目は項目で２行目からデータがあります。
行数は都度相違しますが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

回答No.7

merlionXX · ベストアンサー

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

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

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

に訂正します。

お礼

ありがとうございます。
.Range("A2:F" & n).Value = myW
で思ったとうり動いて今日はたくさん処理できて
助かりました。
もう２２：２４。
あとひとふんばりです。

補足

あけましておめでとうございます。
今年もよろしくお願いします。
今日は仕事です。10日も仕事です。(T_T)

test02は

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 '削除(空白の場合も削除)

test03は

If .Cells(i, 6) = 0 Then
.Rows(i).Delete 'F列が"0"だったらその行を削除
Else 'F列が"0"でなかったら
'E列の値先頭がKとE、先頭2文字が72以外は行削除する
If Left(.Cells(i, 5), 1) <> "K" And Left(.Cells(i, 5), 1) <> "E" And Left(.Cells(i, 5), 2) <> 72 Then 'E列判定（下記参照）
.Rows(i).Delete '削除(空白の場合も削除)

と条件の指定の部分は双方<>です。

test04はtest03の高速型で

'F列が"0"だったらその行を削除
If myV(i, 6) <> 0 Then
'●E列の値先頭がKとE、先頭2文字が72以外は行削除する
If Left(myV(i, 5), 1) = "K" Or Left(myV(i, 5), 1) = "E" Or Left(myV(i, 5), 2) = 72 Then

と条件の指定の部分は=です。

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

02の高速型を作成する場合は

'F列が"0"だったらその行を削除
If myV(i, 6) <> 0 Then
'●E列の値の先頭文字が"7B"でなかったら
If Left(myV(i, 5), 1) = "7B" Or Left(myV(i, 5), 2)

それとも
If Left(myV(i, 5), 1) = 7B Then

でいいのでしょうか？

あと高速型test04の方で
02,03に有る　「E列が空白の場合も行削除」は
どの部分になるのでしょうか？
（コメントを入れたいのですがよく分かりません。）
申し訳ありませんよろしくお願いします。

回答No.10

merlionXX

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

> その状態のまま
> 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

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

お礼

教えていただいたとうりにしてみました。
やはり

自動的に　Sub　エクセル6ファイル選択　がCallされ
MsgBox "６個のBOOKの転記が終了してます。"　となり
Exit Sub　でマクロが終了

でマクロ終了後に再度同じマクロでの処理はできませんでした。
このスレと違う質問ですのでもう閉じます。

もともと別スレで教えていただいた時に
最初から継続したいという要求はしていませんし
1回閉じて、再立ち上げすれば機能上問題は
ないです。
理屈的に継続処理が出来ないのがわかったので
いいです。
（私の改造ミスならして指摘していただきたかった。）
お手数をかけてすいませんでした。
どうもありがとうございました。

補足

はいすいません。
http://okwave.jp/qa/q6327202.html
QNo.6327202
2010-11-18 09:44:57
ANo.1
2010-11-18 11:37:32
で教えていただきました。

でそれを

Sub GetBook()
↓
Sub エクセル6ファイル選択()

Sub GetData(ByRef wb As Object, ByVal myCnt As Integer)
↓
Sub 在庫データ6ファイル転記(ByRef wb As Object, ByVal myCnt As Integer)

にして5回を6回に改造しました。
また冒頭に
別スレで教えていただいた物を改造した

Sub エクセル6ファイル取込()

としてくっつけました。

最初は改造が間違っていると思いましたが
最初に教えていただいた↓の記述だけで行っても、
同じく2回目は取り込みが出来ませんでしたので
質問してみました。m(__)m
実際はそういう運用はしないのですが
暮れにたまたまそういう事をした時に疑問に
思ったままでしたので。m(__)m

改造前↓

Sub GetBook()
Dim ans As Boolean
Static myCnt As Integer
If myCnt >= 5 Then
MsgBox "５個のBOOKの転記が終了してます。"
Exit Sub
End If
ans = Application.Dialogs(xlDialogOpen).Show
If ans Then
myCnt = myCnt + 1
Call GetData(ActiveWorkbook, myCnt)
End If
End Sub
----
Sub GetData(ByRef wb As Object, ByVal myCnt As Integer)
Dim x As Long
MsgBox wb.Name & "からデータを取得します。", vbInformation, myCnt & "回目ですね。"
With wb.ActiveSheet
x = .Cells(Rows.Count, "A").End(xlUp).Row
If myCnt = 1 Then
.Rows("1:" & x).Copy ThisWorkbook.Sheets("Sheet1").Range("A1")
Else
.Rows("2:" & x).Copy ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1)
End If
End With
wb.Close (False)
MsgBox myCnt & "回目の転記が完了"
If myCnt < 5 Then
Call GetBook
Else
MsgBox "５個のBOOKの転記が終了しました。"
Call 編集
End If
End Sub

回答No.9

merlionXX

まだ松の内だから、明けましておめでとうございます。
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列が空白の場合も行削除」はどの部分になるのでしょうか？

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

お礼

お礼が遅れました。
いつもありがとうございます。

＞あと高速型test04の方で
＞02,03に有る　「E列が空白の場合も行削除」は
＞どの部分になるのでしょうか？
＞（コメントを入れたいのですがよく分かりません。）

要求事項を処理している部分に
無理にコメントをいれようとして
馬鹿言ってました。m(__)m
すいません。
教えていただいたとうりでした。

補足

すいません。閉じる前に。もう1回。
merlionXXさんにしか聞けない事なのでm(__)m
最初の質問にて
>ボタンクリックでプロシージャーが起動します。
>そのマクロの中で以下の２つの処理を追加

このマクロというのはmerlionXXさんに教えていただいた物を
改造したものです。

Sub エクセル6ファイル取込()
'これが一番最初に走ります。
Sheets("現在在庫").Select
Cells.Select
Selection.Delete Shift:=xlUp
Range("A1").Select
MsgBox "抽出した６ファイル用意されていますか？"
Call エクセル6ファイル選択
End Sub
-------
Sub エクセル6ファイル選択()
'エクセルファイルを選択します。6回行います。
'1番目のプロシージャーでCallされます。2回目に走ります。
Dim ans As Boolean
Static myCnt As Integer
If myCnt >= 6 Then
MsgBox "６個のBOOKの転記が終了してます。"
Exit Sub
End If
ans = Application.Dialogs(xlDialogOpen).Show
If ans Then
myCnt = myCnt + 1
Call 在庫データ6ファイル転記(ActiveWorkbook, myCnt)
End If
End Sub
----
Sub 在庫データ6ファイル転記(ByRef wb As Object, ByVal myCnt As Integer)
'選択したファイルをシート「現在在庫」に転記します。
'1回目は1行目から、２～６回目は２行目からです。
'2番目のプロシージャーでCallされます。3回目に走ります。
Dim x As Long
MsgBox wb.Name & "からデータを取得します。", vbInformation, myCnt & "回目ですね。"
With wb.ActiveSheet
x = .Cells(Rows.Count, "A").End(xlUp).Row
If myCnt = 1 Then
.Rows("1:" & x).Copy ThisWorkbook.Sheets("現在在庫").Range("A1")
Else
.Rows("2:" & x).Copy ThisWorkbook.Sheets("現在在庫").Cells(Rows.Count, "A").End(xlUp).Offset(1)
End If
End With
wb.Close (False)
MsgBox myCnt & "回目の転記が完了"
If myCnt < 6 Then
'次のファイルを選択する為2番目に走ったプロシージャーをCallします。
Call エクセル6ファイル選択
Else
MsgBox "６個のBOOKの転記が終了しました。"
Call ●このスレで教えていただいたマクロ（test04)
End If
End Sub

これでシート「現在在庫」に取り込んだデータが
このスレで教えていただいたマクロ（test04)で編集された状態で
完了しています。
その状態のまま
Sub エクセル6ファイル取込()を再度走らせます。
↓
MsgBox "抽出した６ファイル用意されていますか？"
↓
「はい」
↓
MsgBox "６個のBOOKの転記が終了してます。"

となり先ほど編集されたシート「現在在庫」のデータが
全て削除されて終わってしまい取込ファイル選択画面になりません。
一度このエクセルを閉じて再度開いて
Sub エクセル6ファイル取込()を起動されば大丈夫です。
実用上問題ないのですがこの原因が分かりません。
通常マクロの処理後、また同じマクロを起動できます。
（処理内容によってはそれをやるとデータは目茶苦茶になりますが）

今回は処理後のシートを別のBOOKにコピペして、
引き続き別データを同じように処理しようとしてマクロを起動したら
出来なかったので疑問が。
暮れからこの件が頭に合ってそのうち次の依頼が大量に来て。
説明が難しいので意味が通じなかったらスルーしてください。
いろいろありがとうございました。

回答No.8

layy

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

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

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

お礼

いろいろとありがとうございました。
年末は助かりました。

回答No.6

layy

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

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

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

お礼

ありがとうございます。
ご指摘のしゅうせいで思ったとおり
動きました。
おかげで助かりました。
まだ、仕事終われませんが．．．．．

回答No.5

merlionXX

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

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

お礼

お礼が遅れました。
ありがとうございました。

補足

謝らないでください。
お願いしているのは私ですので。
全国的にクリスマスイヴですから。
明日も仕事なので（26日～1月5日まで11連休）
今日もがんばります。
楽しいパーティを。

すいません。4行ではなく６行でした。
残るべき対象データとなる３００行の上から６行目だけが
残るようです。

.Range("A2:F" & x).ClearContents
これでデーターが全部消えて
.Range("A2:F" & j).Value = myW
これで条件に該当して配列に取り込まれた
のが貼り付くのですよね。
という事は配列に取り込む時に
６行と制限しているのか
配列には300行分取り込んだけど
貼り付ける時に6行までと
なっているのかな？
そもそももっと違うのかな？

回答No.4

merlionXX

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

そうじゃなくて、普通は英数のデータってたいてい半角でしょ？
かわいい、かわいい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

お礼

ありがとうございます。
1秒かかりませんでした。
ですが
同じデータで行った場合
１０，０００行のうち３００行が残るはずで
03は300行残りました。
04は４行しか残りません。
今見ていますが？？？？です。

補足

>以前のはどれくらいかかってました？
>無駄に二回ループしてたからもっとかかったんじゃないかな。

それがあまり変わりません。
私の記述では7BB以外は全部削除ですから
その辺も関係しているかも？

>でもこんな二回ループ、2007年にわたしが書いてたんだ・・・・。

すいません。２回ループにしたのは私です。
merlionXXさんが他に方に回答なさったのは
（１）の方だけでそれを今回用に書き換えて、
さらに同じ処理だから、
もう１回同じ記述を貼り付けたのです。
２回だと遅くなるのはわかっていましたが
VLOOKUPの時に、
式を貼付し出た値を値貼付する方法より
自作の２回ループの方が速かった事もあり
場合によってはLoopでも速かった時もあったので
挑戦したのですが、駄目でした。
（VLOOKUPはその後
例のdictionaryオブジェクトで秒速以下になりましたが）

>だから質問の時には手を抜かず、
>ちゃんと書いてほしいのです。

手は抜いてないのですが、そこまで気がつかないのです。
すいません。別スレッドでは半角と書いてました。
今回はなぜ抜けたのかな？

はい。Merry Xmas !

イブは会社で過ごし、クリスマスを会社で向かえたらどうしよう.....

回答No.3

layy

単純に考えると、
１００００行あるデータを条件１で検証し、条件２でまた検証するとなると２００００行のデータを操作していることになっているので遅い。２条件から４条件に増やすと倍遅くなるでしょう。

１行分操作するときに、条件１に合えばＬ列に〇、合わなければＬ列に×、条件２に合えばＭ列に〇、合わなければＭ列に×、こんな感じでＬ列が〇でＭ列が〇なら削除だ、ということで１００００行まで行えば操作した行は少なくなり、処理早くなると考えられます。

お礼

ありがとうございます。

条件１は常に同じ条件です。
条件２は今回はE列の3文字にて
先頭から7B以外だったらその行は削除です。

ただ条件2に関してはユーザー要求によって相違します。
例えば
今回は
・先頭から２文字が7Bだけ残してあとは削除
次回は
・先頭がC　と　先頭が　D　と先頭から2文字が76
　を残してあとは削除
その次は
・先頭がWと先頭から2文字が8Sと7G6
　を残してあとは削除

という感じです。
よって条件２の所は要求に応じて
簡単に書き換えが可能な記述
にしたいです。

アドバイスしていただいた内容を
完全に理解できないのですが
こんな感じでいいのでしょうか？
L,M列に判定結果を転記し
その値から行削除を命令する？。
（イメージなのでこのままでは思ったとうりに処理は
　されないのは承知してます。
　これ以上は作れなかったです。（泣））　　

Sub 行削除()
行 = 2
Do
If Cells(行, 1).Value = "" Then Exit Do
If Cells(行, 6).Value = 0 Then
Cells(行, 12).Value = "消"
If Cells(行, 5).Value <> "7BB" Then
Cells(行, 13).Value = "消"
End If
End If
行 = 行 + 1
Loop
With ActiveSheet
x = .UsedRange.Cells(.UsedRange.Count).Row
For i = x To 2 Step -1
If .Cells(i, 12) = "消" Then .Rows(i).Delete
Next
End With

End Sub

回答No.2

merlionXX

> Ａ～Ｆ列までデータが有ります。
とお書きですが、提示されたコードを見ると、'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

あとはご自分でもわかりますね。

データ量が多いから時間はかかるでしょうね。
配列に取り込めは高速化出来ますが、まずは上記の理解でいいかどうかを確認します。

お礼

こんにちは。
merlionXXさんに過去に教えていただいた
数々のマクロを書き換えて合体して
最後までやり遂げようと思いましたが
ギブアップです。
今回提示しました記述はmerlionXXさんが
2007年ぐらいに他の方に回答した物を
持ち出して書き換えたのですが、
これ以上は無理でした。

>> Ａ～Ｆ列までデータが有ります。
>とお書きですが、提示されたコードを見ると、
>'E,F,H,I,K列を列削除した結果、Ａ～Ｆ列のデータになったようです。
>そういう理解でいいのですね？
>普通はそう言葉で書きますよ。

はい。そのとうりです。
やはり私は普通ではないのかな。

>また、アルファベットや数字を全角でお書きですが、
>実際のデータは半角なんじゃないですか？

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

>あとはご自分でもわかりますね。

はっきり「はい」といえないが辛いです。（泣）
一応、例であげた以外のパターン用に
教えていただいた物を書き換えて行いましたら思ったとおりに
結果が変化しましたので条件変更時の変更部分については
理解できていると思います。

>データ量が多いから時間はかかるでしょうね。

はい。02も03も思ったように動きました。
また03は前述のとうり書き換えても思ったように
動きました。
ですが、やはり２～３分は待たないといけません。

どうもありがとうございました。

補足

ちょっと不安です。

>'・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

・CとFと72と8D5以外
If Left(.Cells(i, 5), 1) <> "C" And Left(.Cells(i, 5), 1) <> "F" And Left(.Cells(i, 5), 2) <> 72 Then
And Left(.Cells(i, 5), 3) <> 8D5 Then

でいいのでしょうか？

E列は3ケタか空白なので
8D5という条件はピンポイントで指定なので
= "8D5" Then　の方がいいのでしょうか？
その場合はLeftはいれず

If Left(.Cells(i, 5), 1) <> "C" And Left(.Cells(i, 5), 1) <> "F" And Left(.Cells(i, 5), 2) <> 72 Then
And (.Cells(i, 5) = "8D5" Then

でいいのでしょうか？

回答No.1

layy

最初に列削除してますが

条件１の判定結果をＬ列に
条件２－１の判定結果をＭ列に

条件２－２の判定結果をＮ列に

最終的に削除するかの判定結果をＯ列に

まずはここまでやって判定の妥当性を確認します。

すべての行に判定でき、問題なかったらＯ列をみて削除

随時削除、再描画していることが遅くしていると思います。

処理経過を表示させないコマンドあり、参考。

先頭１文字、２文字の文字列判定はLEFT関数使います。

お礼

ありがとうございました。

＞まずはここまでやって判定の妥当性を確認

難しいです。すいません。

＞処理経過を表示させないコマンドあり、参考。
よく皆さんにアドバイスされてます。
過去の例だとそれでは早くなりませんでした。
今回ははやくなるのでしょうか。

＞先頭１文字、２文字の文字列判定はLEFT関数使います。
その関数での条件付けがよく分かりません。

お手数をおかけいたしました。