Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

73282 / 76807

←次へ　｜　前へ→


	【8008】Re:特定の値の行以外を削除するには

Asaki - 03/9/26(金) 13:51 -


	引用なし

	パスワード

みなさま、こんにちは。

フィルタオプション使ってみました。
エラー処理はしてません。

Sub test()

　　Dim rngTarget　　　　　 As Range　　　　'処理対象レンジオブジェクト
　　Dim rngCriteria　　　　 As Range　　　　'条件設定レンジオブジェクト
　　Dim lngLoop　　　　　　 As Long　　　　 'ループカウンタ
　　
　　Application.ScreenUpdating = False　　　'画面更新処理停止
　　
　　'フィルタ仕様のための準備
　　Rows(1).Insert Shift:=xlDown
　　Columns(3).Insert Shift:=xlToRight
　　Range(Cells(1, 1), Cells(1, 3)).Value = "col1"
　　
　　'抽出条件設定
　　Cells(2, 3).Value = "CJ10"
　　Cells(3, 3).Value = "CJ20"
　　Cells(4, 3).Value = "CJ30"
　　Set rngCriteria = Range(Cells(1, 3), Cells(4, 3))

　　'処理対象レンジ設定
　　Set rngTarget = Range("A1", Cells(Rows.Count, 1).End(xlUp).Offset(, 1))

　　'フィルタリング
　　rngTarget.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=rngCriteria, Unique:=False
　　
　　'非表示行削除
　　For lngLoop = rngTarget.Rows.Count To 2 Step -1
　　　　If Cells(lngLoop, 1).EntireRow.Hidden Then Cells(lngLoop, 1).EntireRow.Delete Shift:=xlUp
　　Next lngLoop

　　'オブジェクト開放
　　Set rngTarget = Nothing
　　Set rngCriteria = Nothing

　　'全データ表示
　　ActiveSheet.ShowAllData

　　'作業行/列削除
　　Rows(1).Delete Shift:=xlUp
　　Columns(3).Delete Shift:=xlToLeft

　　Application.ScreenUpdating = True　　　 '画面更新処理再開

End Sub

1 hits

▼

【8003】特定の値の行以外を削除するには miya 03/9/26(金) 11:42