特定の文字がある行以外を削除するマクロ

特定の文字がある行以外を削除するマクロを作りたいです。

データの範囲はＡ１からＫ50000
Ｅ列にＳ01、Ｓ02、Ｅ03と書いてあるセル以外の行を削除したいです。

Ｅ列にはＳ01～Ｓ５０、Ｅ01～Ｅ１００というような数値があります。

どうぞよろしくお願いします。

No.8 ベストアンサー 回答者： mu2011 回答日時： 2011/02/10 09:11

NO5です。

>やってみましたが、かなり時間がかかってしまいました。
画面更新を無効にする事でもかなり時間短縮できますが如何でしょうか。

Sub 行を削除()
Application.ScreenUpdating = False
For i = Cells(Rows.Count, "E").End(xlUp).Row To 1 Step -1
If Cells(i, "E") <> "S01" And _
Cells(i, "E") <> "S02" And _
Cells(i, "E") <> "E03" Then
Rows(i).Delete
End If
Next
Application.ScreenUpdating = True
End Sub

この回答へのお礼

何度もありがとうございます。
1分以上かかってしまいましたが、できました。
本当にありがとうございます。

お礼日時：2011/02/11 03:06

No.7 回答者： layy 回答日時： 2011/02/09 16:07

補足で。

削除とマイナス、
これくらいならデータ発生元を修正依頼しても難しい話でないだろうが？。

削除は一度失敗するとリランが面倒。削除などせず別シートに必要なデータを作成し、シート名入れ替えれば結果は同じで原本も残るというもの。保守性はどうか？。

削除もFINDも処理遅いし、いつか改善になる可能性あり。

区分増えてもマクロ変えないようにしたいとかないのか。

この回答への補足

これから考えていきたいと思います。
貴重なご意見ありがとうございます。

補足日時：2011/02/11 03:12

No.6 回答者： merlionXX 回答日時： 2011/02/09 15:57

5000行じゃなく5万行のデータなんですね？

ならば、行の削除じゃやたら時間がかかると思います。
いったん配列に取り込んで必要なデータだけ残してあとは消すようにしてみました。

Sub test01()
　　Dim myV, myW, myStr
　　Dim i As Long, j As Long, n As Long, k As Long
　　myStr = Split("S01、S02、E03", "、")
　　myV = Range("A1:K50000").Value
　　ReDim myW(1 To 50000, 1 To 11)
　　For i = 1 To 50000
　　　　For k = 0 To 2
　　　　　　If myStr(k) = myV(i, 5) Then
　　　　　　　　n = n + 1
　　　　　　　　For j = 1 To 11
　　　　　　　　　　myW(n, j) = myV(i, j)
　　　　　　　　Next j
　　　　　　　　Exit For
　　　　　　End If
　　　　Next k
　　Next i
　　Range("A1:K50000").ClearContents
　　Range("A1:K" & n).Value = myW
End Sub

この回答へのお礼

ありがとうございます。
If myStr(k) = myV(i, 5) Thenでエラーになってしまいました。
あと、　myStr = Split("S01、S02、E03", "、")の全角「、」がＯＳの関係上記載できません。

どうしたらいのでしょうか。

お礼日時：2011/02/11 01:49

No.5 回答者： mu2011 回答日時： 2011/02/09 10:35

一例です。

E列を元に規定の文字列（英数字は半角としています）以外の行を削除

Sub 行を削除()
For i = Cells(Rows.Count, "E").End(xlUp).Row To 1 Step -1
If Cells(i, "E") <> "S01" And _
Cells(i, "E") <> "S02" And _
Cells(i, "E") <> "E03" Then
Rows(i).Delete
End If
Next
End Sub

この回答へのお礼

ありがとうございます。
やってみましたが、かなり時間がかかってしまいました。

お礼日時：2011/02/10 07:59

No.4 回答者： tom04 回答日時： 2011/02/09 09:19

No.3です！

前回のコードで誤りがありました。

4行目の
If Cells(i, 5) <> "S01" And Cells(i, 5) <> "S05" And Cells(i, 5) <> "E03" Then
を
If Cells(i, 5) <> "S01" And Cells(i, 5) <> "S02" And Cells(i, 5) <> "E03" Then
に訂正してください。

何度も失礼しました。m(__)m

この回答へのお礼

やってみたら全部削除されてしまいました。
やはり文字列の問題でしょうか。
前後の空白も一緒にしてみたんですが。。。


でも非常に参考になりました。
ありがとうございました。

お礼日時：2011/02/11 01:44

No.3 回答者： tom04 回答日時： 2011/02/09 09:16

こんにちは！

一例です。
データは必ず5000行目まであるとして・・・

Sub test()
Dim i As Long
For i = 5000 To 1 Step -1
If Cells(i, 5) <> "S01" And Cells(i, 5) <> "S05" And Cells(i, 5) <> "E03" Then
Range(Cells(i, 1), Cells(i, 11)).Delete (xlUp)
End If
Next i
End Sub

こんな感じではどうでしょうか？
尚、データがなくても5000行目から操作していきますので、少し時間がかかると思います。m(__)m

No.2 回答者： keithin 回答日時： 2011/02/09 08:49

sub sample2()

　if application.counta("E2:E500") = 0 then exit sub
　range("L:L").insert
　range("L2:L5000").formula = "=(E2=""Ｓ01"")+(E2=""Ｓ02"")+(E2=""Ｅ03"")"
　range("L:L").autofilter field:=1, criteria1:=0
　range("A2:L5000").entirerow.delete shift:=xlshiftup
　activesheet.autofiltermode = false
　range("L:L").delete shift:=xlshifttoleft
end sub

など。

この回答へのお礼

やってみたんですが。データが一つも削除されませんでした。
Ｓ01等の文字がうまく認識されてないのかな？？？

でも非常に参考になりました。
ありがとうございました。

お礼日時：2011/02/11 01:40

No.1 回答者： KURUMITO 回答日時： 2011/02/09 07:07

マクロを使うよりも関数を使って別のシートに抽出したものを表示させるのがよいでしょう。

シート１の２行目から下方にデータがあるとしてＬ２セルには次の式を入力します。

=IF(OR(E2="S01",E2="S02",E2="E03"),MAX(L$1:L1)+1,"")

その後にＬ２セルを選択して右クリックして「コピー」を選択します。
次いで数式バー上にはＬ２と表示されていますがL2:L50000と入力してから確定します。これでＬ２セルからＬ５００００セルまでが選択状態になりますので右クリックして「貼り付け」を選択します。
これでＬ列にはS01,S02,E03と書かれた行にのみ上から番号が付けられます。

次にシート２に移ってＡ２セルには次の式を入力します。

=IF(COUNTIF(Sheet1!$L:$L,ROW(A1))=0,"",INDEX(Sheet1!$A:$K,MATCH(ROW(A1),Sheet1!$L:$L,0),COLUMN(A1)))

その後にＡ２セルを選択してから右クリックして「コピー」を選択します。
次いで数式バー上にはＡ２と表示されていますがA2:K50000と入力してから確定します。これでA２セルからK５００００セルまでが選択状態になりますので右クリックして「貼り付け」を選択します。

お望みの表が表示されますね。

この回答への補足

早速回答ありがとうございます。

でも今回は、会計データベースからダウンロードしたデータに一連の処理
をして、別のデータを作るというマクロを作成しており、
この作業はその途中で発生するものです。
なので、すみませんがマクロの記載方法を教えていただけると大変助かります。

どうぞよろしくお願いします。

補足日時：2011/02/09 07:30