• ベストアンサー

<Excel>VBAでのオートフィルタについて

このような式で必要な行を抽出していたのですが、65536行下から検索をかけるので時間がかかります。 データの入っている一番下の行から上へ検索していくにはどのような方法があるでしょうか? Sub sDelLine() Dim i As Long For i = 65536 To 1 Step -1 If Cells(i, 3) = "男" Then Rows(i).Select Selection.Delete Shift:=xlUp End If Next End Sub

質問者が選んだベストアンサー

  • ベストアンサー
noname#109516
noname#109516
回答No.1

r = Cells(65536, 3).End(xlUp).Row で変数rに3列目のデータの入っている最下行を取得できます。 後は65536をrに変えるだけです。

gaku2005
質問者

お礼

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

関連するQ&A

  • マクロ オートフィルタで困っています。

    マクロ オートフィルタで困っています。 1列目と2列目からそれぞれ条件をフィルタで抽出し、抽出された行を削除するマクロを組んだのですが(下記)、Bの条件が表にない場合に2行目から下が全て削除されてしまいます。 元の表は毎週変わるため、抽出する条件があるかないかはその時次第です。 オートフィルタにこだわってはいませんが、その他の抽出方法もいまいち分からず……。 どのようにすればよいのか、教えていただけますでしょうか。 宜しくお願い致します。 <マクロ> Sub Macro() Selection.AutoFilter Field:=1, Criteria1:="A" Selection.AutoFilter Field:=2, Criteria1:="B", Operator:=xlAnd Dim gyou(1) As Long gyou(0) = 2 gyou(1) = Range("A1").CurrentRegion.Rows.Count Rows(gyou(0) & ":" & gyou(1)).Select Selection.Delete Shift:=xlUp End Sub

  • VBA アプリケーション・オブジェクト定義のエラー

    ある行と別の行と同じ内容の文章が入っている場合、それを削除するマクロをくんでいますが、 アプリケーション・オブジェクト定義のエラーとのことで作動してくれません。。。 以下のような記述なのですが、アドバイスをいただけたら幸いです。 よろしくお願いいたします。 Sub 重複削除() Dim dataend Cells(Rows.Count, 5).End(xlUp).Select dataend = ActiveCell.Row For i = 2 To dataend - 1 For k = 1 To dataend - i If Cells(2, i).Value = Cells(2, i + k).Value Then '''''''''''''''''''''ここでひっかかる Rows(i + 1).Select Selection.Delete End If Next Next End Sub

  • for next教えて下さい(;_;)

    以下のように1行残して9行消してという操作を連続してやりたいのですがfor nextをどう使えばうまくいくのかわかりません。誰か教えて下さいお願いしますm(_ _)m Sub Macro1() ' ' Macro1 Macro ActiveWindow.SmallScroll Down:=5 Rows("10:18").Select Selection.Delete Shift:=xlUp Rows("11:19").Select Selection.Delete Shift:=xlUp End Sub

  • VBA 特定の文字の検索方法

    VBA初心者です。 c列に入力されている「01-」~「09-」までのうち 「02-」で始まるものを探し、その行のA・B・C列を削除し 上につめたいのですが、うまくいきません。 「02-」の後には何文字か入っています(例:02-AN003) 以下のように記述したのですが。。。 VBA初心者ですのでどなたかご教授下さい。 Sub sakujyo() Dim i As Long For i = Range("C" & Rows.Count).End(xlUp).Row To 2 Step -1 If Range("C" & i).Value = "02-*" Then Rows(i).Delete Shift:=xlUp Next i End Sub

  • 重複データーの集計、削除

    どなたかご教授下さい。 下記のようにD列に重複する行があればI列に集計し、行削除するマクロを作成しました。 さらに、重複する基準となる列を複数(D列,F列,G列)に増やしたいのですが、上手く出来ません。 宜しくお願い致します。 Sub test() Dim i, j For i = 19 To Cells(Rows.Count, 2).End(xlUp).row - 1 For j = Cells(Rows.Count, 2).End(xlUp).row To i + 1 Step -1 If Cells(i, 4).value = "" Then Exit Sub If Cells(i, 4).value = Cells(j, 4).value Then Cells(i, 9).value = Cells(i, 9).value + Cells(j, 9).value Rows(j).Delete End If Next Next End Sub

  • エクセルVBA どうしても処理が重いのを改善したい

    下記のコードを作りましたが、どうしても処理が2分を越えてしまいます。 書き方が下手なのか。。。修正案があればぜひともご教授願います。 行っている事は。。。 1.上から順番に最後の文字が入っている所まで検索をする。 2.1の際A2とA3セル内容を取得する。(この際にA2セルに入っているドメイン取得している)この取得した値を検索元のデータとしている。 3.2にて取得したデータを元に、検索対象セルの次行から一致する値を検索する。 4.ヒットしたら、ヒットした値がある行のE列に「1」を代入 5.全ての処理が終了したら、E列に「1」がある行全て削除 6.フィルター解除 Sub 案件抽出の重複削除() Debug.Print Time & " - 案件抽出の重複削除スタート" Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Dim s As String '// 検索元データ Dim i As Long Dim SI As String '// 検索元データの結合データ Dim TD As String Dim SS As String Dim II As Long Dim AJS As Range '// 検索元データのステートメント Dim CAJS As Range '// 検索されるデータのステートメント On Error Resume Next For Each AJS In Range("A2:A" & Cells(100000, 1).End(xlUp).Row) s = Cells(AJS.Row, 2) i = InStrRev(s, "@") + 1 SI = Mid(s, i, Len(s) - i) & Cells(AJS.Row, 3) For Each CAJS In Range(Cells(AJS.Row + 1, 2), Cells(Rows.Count, 1).End(xlUp)) If Cells(CAJS.Row, 5) = "" Then SS = Cells(CAJS.Row, 2) II = InStrRev(SS, "@") + 1 TD = Mid(SS, II, Len(SS) - i) & Cells(CAJS.Row, 3) If SI = TD Then Cells(CAJS.Row, 5) = 1 End If TD = "" End If Next Next ActiveSheet.Range("$A$1:$E$2564").AutoFilter Field:=5, Criteria1:="1" Rows(2).Select Range(Selection, Selection.End(xlDown)).Select Selection.Delete Shift:=xlUp Selection.End(xlUp).Select ActiveSheet.AutoFilterMode = False Debug.Print Time & " - 案件抽出の重複削除終了" End Sub 宜しくお願い致します。

  • 連続して同じ値が入ってるなら削除したいのですが

    指定した値なおかつ連続して同じ値が入ってるなら削除したいのですが A列に 紅葉 紅葉 桜 桜 紅葉 とはいっていて、 Sub Sample() Dim i As Long Dim mystr As String mystr = "桜" For i = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1 If Cells(i, 1) = Cells(i - 1, 1) = mystr Then Rows(i).Delete End If Next i End Sub をしても、削除されません。 4行目の桜が削除されてもいいと思うのですが コードのどこが間違えてますか?

  • エクセル マクロで行削除のコードについての質問です

    ある指定のセル範囲が空白ならその行自体を削除したいですが 上手くいきません。 記述したコードは以下の通りです。 Sub A01() Dim IRow As Long Dim d As Variant, i As Variant d = InputBox("抽出する日数を入力してください", "日数") If d = "" Then Exit Sub lRow = Cells(Rows.Count, 1).End(xlUp).Row For i = lRow To 2 Step -1 If ActiveSheet.Range(Cells(i, 5), Cells(i, d)) = Empty Then ActiveSheet.Rows(i).EntireRow.Delete End If Next End Sub Ifの判定の部分でエラーが出ます。 どう修正したらよいかご教示願います。

  • VBAで削除を早くしたいのですが…

    Excel2007のVBAです。キー記録を眺めながら四苦八苦しております。 数千行あるデータで、A列が"d"以外の行を削除したいのですが PCスペックが低いせいか、時間がかかってしまいます。 簡単に効率化することは可能でしょうか? よろしくお願いします。 ※1行目はタイトル列、全体行数は可変です。 Sub A05_A列がd以外は削除する() Application.ScreenUpdating = False Dim sh2 As Worksheet Set sh2 = Worksheets("削list") For i = Cells(Rows.Count, "C").End(xlUp).Row To 2 Step -1 If sh2.Cells(i, "A").Value <> "d" Then Rows(i).Delete End If Next Application.ScreenUpdating = True End Sub

  • エクセル VBA Rowsプロパティ?

    エクセル VBAにて ある列の空白セルを調べて空白があった場合 行全体を選択して削除したいため、下記のように書き込みました。 Dim idx As Integer For idx = 5 To 2204 If ActiveSheet.Cells(idx, 2) = "" Then Rows("idx:idx").Select Selection.Delete Shift:=xlUp End If Next idx Rows("idx:idx").Selectが間違っていると思うのですが 変数を使用しての行指定がわかりません。 どなたかご教示お願いいたします。