FALSEの行を削除したい

質問

office365

データベースから抽出したデータでフラグがFALSEの行を削除したい。
行数は2万行くらいある状態。

データの状態は
A列に親となる番号のコード
B列に順番と品番が結合されたコード
C列にフラグのコード
で、具体的なデータのイメージは下記状態

A列　　　B列　　C列
A0001 1code1 TRUE
A0001 2code1 TRUE
A0001 2code1 FALSE
A0001 3code1 TRUE
A0001 4code1
A0001 5code1 TRUE
A0001 6code1 TRUE
A0001 7code1 TRUE
A0001 8code1 TRUE
A0001 9code1 TRUE
A0001 10code1 TRUE
A0001 11code1 TRUE
A0001 12code1 TRUE
A0002 1code2 TRUE
A0002 2code2 TRUE
A0002 3code2 TRUE
A0002 4code2 TRUE
A0002 5code2 TRUE
A0002 6code2 TRUE
A0002 7code2 TRUE
A0002 8code2 TRUE
A0003 1code3 TRUE
A0003 2code3 TRUE
A0003 3code3 TRUE
A0003 3code3 FALSE

この状態でC列がFALSEとなっている行を削除したい。
C列がNULLの行はそのまま残す。

これを実現するマクロを下記の様にしました。

C列NULLのセルをいったんTRUEに置換、
sub macro1()
Dim LASTROW1 As Long 'シートのmax行数
LASTROW1 = Worksheets("sheet1").Cells(Rows.count, 1).End(xlUp).Row

Range("C2: C" & LASTROW1).Select

Selection.Replace What:="", Replacement:="TRUE", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula

end sub

C列で並び替えてTRUEの行を別シート(work)へコピー
sub macro2()

ThisWorkbook.Worksheets("sheet1").Select

Dim t As Long

t = 2

Dim LASTROW As Long
LASTROW = Worksheets("sheet1").Cells(Rows.count, 1).End(xlUp).Row

Range("A:C").Select
Selection.AutoFilter

ActiveSheet.Range(Cells(1, 1), Cells(LASTROW, 3)).AutoFilter Field:=3, Criteria1:="TRUE"

Rows(t & ":" & LASTROW).Select

Selection.Copy
Sheets("work").Select
Range("A1").Select
ActiveSheet.Paste

end sub

実行結果

A0001 1code1 TRUE
A0001 2code1 TRUE
A0001 3code1 TRUE
A0001 4code1
A0001 5code1 TRUE
A0001 6code1 TRUE
A0001 7code1 TRUE
A0001 8code1 TRUE
A0001 9code1 TRUE
A0001 10code1 TRUE
A0001 11code1 TRUE
A0001 12code1 TRUE
A0002 1code2 TRUE
A0002 2code2 TRUE
A0002 3code2 TRUE
A0002 4code2 TRUE
A0002 5code2 TRUE
A0002 6code2 TRUE
A0002 7code2 TRUE
A0002 8code2 TRUE
A0003 1code3 TRUE
A0003 2code3 TRUE
A0003 3code3 TRUE

となる様にしたいのです。

いちおうmacro1とmacro2の内容で目的は達成されているのですが、
もっとすっきりするマクロがあれば教えていただきたく。

回答No.1

SI299792 · ベストアンサー

フィルターでFaise を抽出して削除するのが手っ取り早いです。
Option Explicit
'
Sub Macro1()
　　Dim REnd As Long
'
　　ActiveSheet.AutoFilterMode = False
　　REnd = Cells(Rows.Count, "A").End(xlUp).Row
　　Range("A1:C" & REnd).AutoFilter 3, "False"
　　Range("2:" & REnd).Delete
　　ActiveSheet.AutoFilterMode = False
End Sub

お礼

回答ありがとうございます。
なるほどでした。

助かりました。(^^)/

回答No.2

imogasi

少数例でテスト。やってみてください。
質問例のデータの一部をSheet1に作成。下記のC列の中で適当にFALSE行を増やす。
先頭行に見出しを入れる（下記AA,BB,CC。フィルタ―用に必要）。
AA　　　BB　　　CC
A0001 1code1 TRUE
A0001 2code1 TRUE
A0001 2code1 FALSE
A0001 3code1 TRUE
A0001 4code1
A0001 5code1 TRUE
A0001 6code1 TRUE
A0001 7code1 TRUE
A0001 8code1 TRUE
A0001 9code1 TRUE
A0001 10code1 TRUE
A0001 11code1 TRUE
A0001 12code1 TRUE
A0002 1code2 TRUE
A0002 2code2 TRUE
A0002 3code2 TRUE
A0002 4code2 TRUE
A0002 5code2 TRUE
A0002 6code2 TRUE
A0002 7code2 TRUE
A0002 8code2 TRUE
A0003 1code3 TRUE
A0003 2code3 TRUE
A0003 3code3 TRUE
A0003 3code3 FALSE
で、Sheet2にコピーする。安全策のため。
ーー
標準モジュールに
Sub test01()
Worksheets("Sheet1").Range("a1").CurrentRegion.Copy Worksheets("Sheet2").Range("a1")
End Sub
＝＝以下が本番
Sub test02()
Worksheets("Sheet2").Range("a1").CurrentRegion.Select
Range("A1:C26").AutoFilter Field:=3, Criteria1:="FALSE", Operator:=xlFilterValues
ActiveWindow.VisibleRange.Cells.Delete
End Sub
ーー
今く行けば簡潔なコードなんだが。
＞Criteria1:="FALSE", Operator:=xlFilterValuesの辺りで、実データと違い、うまく行かないかも。質問にそのあたりの記述がないため、そうした。うまく行かない場合は、すみません。

お礼

回答ありがとうございます。
なるほどでした。