Excel2000マクロ_検索値以外の行削除方法
- Excel2000のマクロを使用して、特定の条件を満たさない行を削除する方法を教えてください。
- シート全体に対して、B2からB列の最終行までの値が50の倍数以外の行を削除したいです。
- 提供されたマクロでは、逆に残したい行が削除されてしまいます。どのようなコードを書けば良いでしょうか？
- ベストアンサー
Excel2000マクロ_検索値以外の行削除をしたい。
全てのシートに対して、B2からB列の最終行までの値が 50の倍数（MAX600迄で0を含む）以外の行を削除したいのですが 下記のマクロだと逆に残したい行を消してしまいます。 この場合は、どの様なコードを書いた方が良いのでしょうか？ 宜しくお願いします。 Sub 行削除() Dim trow As Range Do Set trow = Range("B").Find(What:=50, LookIn:=xlValues) If trow Is Nothing Then Exit Sub Rows(trow.Row).Delete Loop End Sub
- hibohibo
- お礼率80% (50/62)
- オフィス系ソフト
- 回答数1
- ありがとう数1
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
こんばんは。 >B2からB列の最終行までの値が >50の倍数（MAX600迄で0を含む）以外の行を削除したいのですが Find メソッドでは、ちょっと厳しいかな？ Sub DeleteMultiFifties() Dim i As Long Application.ScreenUpdating = False With ActiveSheet For i = .Range("B65536").End(xlUp).Row To 2 Step -1 If .Cells(i, 2).Value Mod 50 <> 0 And .Cells(i, 2).Value <= 600 Then .Rows(i).Delete End If Next i End With Application.ScreenUpdating = True End Sub
関連するQ&A
- VBA 特定の文字列を含む行を削除する方法
特定の文字列を含む行を削除する方法が知りたいです。 行を削除する方法はWebで見つけたのですが↓ ---------------------------------------------------- Sub 特定の文字列を含む行を削除() Dim c As Range Dim myRow As Long With Range("A:A") Set c = .Find("特定の文字列") Do While Not c Is Nothing Rows(c.Row).Delete shift:=xlUp Set c = .Find("特定の文字列") Loop End With End Sub ---------------------------------------------------- ↑行を指定している箇所のRowsを Columns RowをColomn に変更して以下の様にしてみました、 Columns(Colomn,c).Delete shift:=xlUp だめでした、、、。 VBAの知識が乏しく、組み立て方について理解が無いため、どうすればよいかさっぱりわからず、、 こちらで質問させて頂きました。。。 何卒宜しくお願い致します。
- ベストアンサー
- オフィス系ソフト
- 行の削除
列Ｋに、削除という文字が入っている場合は、その行を削除するということで、3000行くらいあるなかで3分の2程度は削除する行に該当します。 下のマクロで試してみましたが、このマクロではとっても時間がかかってしまうんですが、どうしたら早く処理できるのか教えて下さい。 Dim R As Range Do Set R = ActiveSheet.Range("K:K").Find(What:="削除", LookAt:=xlWhole) If R Is Nothing Then Exit Sub R.EntireRow.Delete Loop
- 締切済み
- その他(ソフトウェア)
- エクセル 同じ内容行削除マクロ 2
シート1、シート2（基準）のB列を比較して同じ内容行を削除したいのですが、「栃木県3」と「＃栃木県3」を同じのもと考えて削除されてしまいます。 Sub 削除() Dim wh1 As Worksheet Dim wh2 As Worksheet Dim f As Range Dim wR As Integer Dim mR As Long Dim wStr As String ' Set wh1 = Worksheets("Sheet1") Set wh2 = Worksheets("Sheet2") wR = 0 With wh1 mR = .Cells(Rows.Count, "A").End(xlUp).Row For wR = mR To 1 Step -1 wStr = .Cells(wR, "B") Set f = wh2.Range("B1:B" & wh2.Cells(Rows.Count, "B").End(xlUp).Row).Find(wStr) If Not f Is Nothing Then .Rows(wR).Delete End If Next End With End Sub 解決策教えて下さい。
- ベストアンサー
- オフィス系ソフト
- 特定文字列を含む行を削除するマクロ
すみませんどなたか教えてください。 エクセルで商品の在庫管理をしておりまして、AP列に製品メーカー名が入っているのですが、 いくつかの（数十個）メーカーを省き削除したく思い、以下のようなマクロをググって作ってみましたが、 上手く動きませんでした。 1つのメーカーだけ記載した場合はうまく動きました。 やりたいことは1つのマクロの中に、数十個のメーカー名を記入しておき、そのメーカーを全件 検索して、AP列に文字列が含まれる場合は、その行を削除したいです。 宜しくお願い致します。 ～～～～～～ Sub DelLines1() Dim R As Range Do Set R = ActiveSheet.Range("AP:AP").Find(What:="softbank", LookAt:=xlPart) If R Is Nothing Then Exit Sub R.EntireRow.Delete Loop Sub DelLines2() Dim R As Range Do Set R = ActiveSheet.Range("AP:AP").Find(What:="docomo", LookAt:=xlPart) If R Is Nothing Then Exit Sub R.EntireRow.Delete Loop Sub DelLines3() Dim R As Range Do Set R = ActiveSheet.Range("AP:AP").Find(What:="au", LookAt:=xlPart) If R Is Nothing Then Exit Sub R.EntireRow.Delete Loop End Sub
- ベストアンサー
- Excel（エクセル）
- マクロの関係で困ってしまいました。印刷できません
Sub Sample3() Dim i As Long, k As Long, c As Range, r As Range i = InputBox("入替え元番号を入力") k = InputBox("入替え先番号を入力") Set c = Range("A:A").Find(what:=i, LookIn:=xlValues, lookat:=xlWhole) Set r = Range("A:A").Find(what:=k, LookIn:=xlValues, lookat:=xlWhole) On Error Resume Next If c.Row < r.Row Then i = c.Row k = r.Row Else i = r.Row k = c.Row End If Rows(k + 1).Insert Rows(i).Cut Cells(k + 1, "A") Rows(k).Cut Cells(i, "A") Rows(k).Delete End Sub 上記のようなマクロを組んで頂いたのですが、「改ページ位置を移動できません」という状況になっています。せっかくgooの質問で答えて頂いたのですが、これでやったら８０行ぐらいから、この表示が出て、解決できません。どなたか、解決して頂けませんか。その時に補足すればよかったのですが、動かしてみて分かった次第です。お答え頂いた方に大変申し訳なく思っています。よろしくお願いします。 なお、間違った入力をしてしまった時に、一回だけは元に戻るなんてことはできないですかね。これもできたら厚かましいですがお答え頂けたらと思います。
- ベストアンサー
- Excel（エクセル）
- 指定行の削除の方法
全くの初心者です ご教授願います ユーザーフォーム６のテキストボックスに入力された 文字と同じもののある行を削除するようにしたいです （コードは、インターネットから借りてきて、必要と思われるところを修正しました） 実行すると、「オブジェクトは、このプロパティに対応していません」 と表示されてしまいます。 何の事を言っているのか、わかりません 教えていただきたいです。 よろしくお願いします Sub CommandButton1_Click() Dim 削除氏名 As Range Set 削除氏名 = Cells.Find(What:=userform6.TextBox1, LookIn:=xlValues, LookAt:=xlWhole) If Not 削除氏名 Is Nothing Then 削除氏名.EntireColumn.Delete = True End If End Sub
- ベストアンサー
- Visual Basic
- マクロFind検索で見つからなかった時の対処
エクセル2013です 以下のコードを作成しましたが .Rowが色で塗られ 「型が違います」でERRになります。 .Columnの方はERRでなく なぜ.Rowの方がERRなのでしょうか？ よろしくお願いします。 Dim 検索行番号 As Range Dim 判定列番号 As Range Dim 検索列番号1 As Range Dim 検索列番号2 As Range Set 検索行番号 = Rows(1).Find("みかん").Column If 検索行番号 Is Nothing Then MsgBox "みかんが有りません。" End If Exit Sub Set 判定列番号 = Rows(1).Find("りんご").Column If 判定列番号 Is Nothing Then MsgBox "りんごが有りません。" End If Exit Sub Set 検索列番号1 = Range("B:B").Find("大箱").Row If 検索列番号1 Is Nothing Then MsgBox "大箱が有りません。" End If Exit Sub Set 検索列番号2 = Range("B:B").Find("小箱").Row If 検索列番号2 Is Nothing Then MsgBox "小箱が有りません。" End If Exit Sub
- ベストアンサー
- Excel（エクセル）
- 空白行の削除マクロについてご教示ください
空白行の削除に、下記マクロを活用させていただいていますが、 見た目空白なのに削除されない行が時々残ってしまいます。 削除されなかったセルを「Deleteキー」で空白にするとマクロが 実行され、きちんと削除されます。 こういった、スペースか何かが入っていても、見た目空白なら 削除するようにはできないでしょうか。 どなたかよろしくお願いいたします。 Sub 削除() Dim c As Range Dim 開始行 As Long Dim 最終行 As Long 開始行 = 5 最終行 = Range("a5000").End(xlUp).Row For Each c In Range("a" & 開始行 & ":a" & 最終行) If c.Value = "" Then Rows(c.Row).Delete End If Next End Sub
- ベストアンサー
- オフィス系ソフト
- 特定文がある行を削除
特定分がある行を削除しようと思い、以下のように設定いたしました。 Sub DelLines() Dim R As Range Do Set R = ActiveSheet.Range("A:A").Find(What:="指定文", LookAt:=xlWhole) If R Is Nothing Then Exit Sub R.EntireRow.Delete Loop End Sub これを、全てのシートに適用するにはどのように書けばよろしいのでしょうか？
- ベストアンサー
- Excel（エクセル）
- マクロで困ってます！
マクロでセル検索かけたらそのセルに設定していたハイパーリンクが外れてしまいます。 どうすればいいでしょうか・・？お力を貸してください！ バージョンは2007です！ コードは下記になります！ 同一ブック内の「データ」というシートにあるものを「検索更新」というシートで検索をかけるというものです。 宜しくお願いします！！ Sub 検索2() myLAST = Range("B" & ActiveSheet.Rows.Count).End(xlUp).Row + 1 If myLAST < 5 Then myLAST = 5 Range("A5:F" & myLAST).ClearContents Set myC = Sheets(1).Columns(3) _ .Find(What:=Range("E2").Value, _ LookIn:=xlValues, LookAt:=xlPart) ' If myC Is Nothing Then Exit Sub myCa = myC.Address Do myLAST = Range("B" & ActiveSheet.Rows.Count).End(xlUp).Row + 1 Range("A" & myLAST) = myC.Row Range("B" & myLAST) = myC.Offset(0, -1) Range("C" & myLAST) = myC.Offset(0, 0) Range("D" & myLAST) = myC.Offset(0, 1) Range("E" & myLAST) = myC.Offset(0, 2) Range("F" & myLAST) = myC.Offset(0, 3) Set myC = Sheets(1).Columns(3).FindNext(myC) If myC Is Nothing _ Or myCa = myC.Address Then Exit Do Loop Set myC = Nothing End Sub Sub 更新() myLAST = Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row If myLAST < 5 Then myLAST = 5 For Each myC In Range("A5:A" & myLAST) If myC.Value = "" Then Exit Sub With Sheets(1) .Range("B" & myC.Value) = myC.Offset(0, 1) .Range("C" & myC.Value) = myC.Offset(0, 2) .Range("D" & myC.Value) = myC.Offset(0, 3) .Range("E" & myC.Value) = myC.Offset(0, 4) .Range("F" & myC.Value) = myC.Offset(0, 5) End With Range("A" & myC.Row & ":F" & myC.Row).ClearContents Next MsgBox "更新しました" End Sub
- ベストアンサー
- オフィス系ソフト
お礼
Wendy02様、お久しぶりです月曜日に確認したいと思います。 回答ありがとうございます。