• ベストアンサー

Excel2000 マクロで行を削除したいのですが

みなさん、こんにちは。今、社員の給与データをもとにExcel2000 で ある集計をとるマクロを組んでいて、下記のような「給与額が0円の データのみ削除する」マクロを組みました。 Sub データ削除() Sheets("Sheet1").Select Range("A1").Select Dim 行 As Long For 行 = 6226 To 2 Step -1 With Cells(行, 7) If .Value > 0 Then Exit For If .Value = 0 Then Rows(行).Delete End With Next End Sub このマクロで正しく動いているのですが、 For 行 = 6226 To 2 Step -1 の構文の 6226 が問題で、これは 6226行目から上に向かって行を削除してい きます。 対象データの量が毎回違うので、データ量がマクロに指定されている行数より 多いと正しく動かないと思いますし、少なければ効率が悪くなるのではと思い ます。 そこで、「データの一番下のセルから削除を始める」設定にしたいのですが、 どうしたらよいでしょうか? ちなみに、データは給与額をキーに降順に並んでいて下の行から削除していく ようになっています。

  • ariga
  • お礼率44% (55/123)

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

  • ベストアンサー
  • paku_i
  • ベストアンサー率38% (19/49)
回答No.1

こんにちはpaku_iです。 列Aにはブランクの行が無いと仮定しますと Range("A1").Select の下の行に Selection.End(xlDown).Select を追加します。 すると一番下の CELL がアクティブになりますのでActiveCell.Row がここで言う 6226 になります。 ということで 最終行 = ActiveCell.Row For 行=最終行 TO 2 Step -1 で良いのではないでしょうか。

ariga
質問者

お礼

いや~。とっても助かりました。説明も良くわかりましたし、実際にやってみたらとってもうまく動きました。ありがとうございました。

その他の回答 (2)

  • bin-chan
  • ベストアンサー率33% (1403/4213)
回答No.3

うろ覚えですが、 CurrentRegion.Rows.Countで行数を取得できませんでしたっけ? これを変数に放り込んだらよろしいかと存じます。

  • gould09
  • ベストアンサー率33% (196/589)
回答No.2

具体的なシートのイメージが無いので、想像で書きます。 案1.データ件数は分かりませんか、その件数から計算出来ないでしょうか。 案2.最後の行を見分ける為の目印はありますか?    最後まで、同じ2行の組み合わせが続くのでしたら、    スペース行が始まる場所を調べればいいかもしれません。

関連するQ&A

  • 指定した範囲で0の行を削除するマクロ

    以下のコードで7列目が0の行を削除するマクロを作ったのですが、 13行目以降を削除するように指定できますでしょうか? 1-12行は別のシートに数式を入れているため、削除したくないのですが、 うまくいきません。よろしくお願いいたします。 Sub 行削除() Dim Rw As Long Dim Cnt As Long Application.ScreenUpdating = False For Rw = Cells(Rows.Count, 7).End(xlUp).Row To 1 Step -1 With Cells(Rw, 7) If .Value = 0 Then .EntireRow.Delete Cnt = Cnt + 1 End If End With Next If Cnt = 0 Then MsgBox "削除対象行は、見つかりません。", vbExclamation Else MsgBox Cnt & " 件見つかり行を削除しました。", vbInformation End If End Sub

  • 重複行を完全削除するエクセルのマクロ

    Sub sakujyo() Dim i, ii As Long For i = 1 To Range("a65336").End(xlUp).Row For ii = Range("a65336").End(xlUp).Row To i + 1 Step -1 If Cells(i, 4).Value = Cells(ii, 4).Value _ And Cells(i, 13).Value = Cells(ii, 13).Value Then Delete Shift:=xlUp End If Next ii Next i End Sub マクロに関しては、素人でございます。 こちらのマクロを作ってみたのですがうまくいきません。 4列目と13列目の列が重複したときのみ重複した行をすべて削除させたいと思っております。どうぞお教えください。

  • 重複行削除のマクロ

    重複行を削除するマクロを作っていますが、うまくいきません。 2行目にタイトルが入っていて、3行目以降が必要なデータになります。 この中でA列が一致しているデータ行を削除したいと考えており、 重複データが削除された後、タイトル行がなぜか一番下の行にはりついてしまいます。 どなたか詳しい方助けてください!!!よろしくお願いします。 ちなみに以下が現在使用しているVBAコードです。 =============================================================== Sub GoodRemoveDuplicates() 'A列にデータが入力されており、そのデータを並べ替えた後、 '重複するデータが含まれている行を削除するマクロ Worksheets("貼り付け用用マクロ").Range("A1").Sort _ key1:=Worksheets("貼り付け用用マクロ").Range("A1") Set currentCell = Worksheets("貼り付け用用マクロ").Range("A1") Do While Not IsEmpty(currentCell) Set nextCell = currentCell.Offset(1, 0) If nextCell.Value = currentCell.Value Then currentCell.EntireRow.Delete End If Set currentCell = nextCell Loop End Sub ===============================================================

  • 条件に合った行を削除するマクロについて

    こんにちは 今、現在、とある条件にあった行を削除するマクロ作っているのですが、 インターネットを調べてみると後ろから探索して、1行ずつ消していくのがいいと書いてありました。 まぁ、その理屈はわかるんですが、それなら 「Unionでセルの範囲を結合してから、最後に一度に消してしまった方が速いのでは」 (消す作業が1度だけで済むから) と思い試してみたんですが、実際試したところ・・・ ものすごく遅かったです。 (ちなみに、1万件のデータで削除した行数は6000ほどでした) 何故Union結合だと遅いのでしょうか? 速いマクロを作成するには、やはり後ろから探索して、1行ずつ消していくしかないのでしょうか? 以下は試したマクロです。 (test が unionで試したマクロ、test2が後ろから1行ずつ削除したマクロ) Option Explicit Public Sub test() Dim r As Range Dim r1 As Range 'Cells.Replace "-", " " For Each r In Range("A2", Range("A65536").End(xlUp)) If r = r.Offset(1, 0) And r.Offset(0, 1) < r.Offset(1, 1) Then If r1 Is Nothing Then Set r1 = r Else Set r1 = Union(r1, r) End If End If Next r1.EntireRow.Delete ' r1.Select End Sub Public Sub test2() Dim r As Range Dim r1 As Range Dim i As Integer 'Cells.Replace "-", " " Application.ScreenUpdating = False For i = Range("A65536").End(xlUp).Row To 1 Step -1 If Cells(i, 1) = Cells(i + 1, 1) And Cells(i, 2) < Cells(i + 1, 2) Then Cells(i, 1).EntireRow.Delete End If Next Application.ScreenUpdating = True End Sub

  • excel2000マクロについて

    下記の様なマクロを書いていますが、別のマクロの記述の仕方で短縮に書くことはできないでしょうか。 Sub 承認捺印() Sheets("実行").Select If Range("E13").Value = "申請者" Then Sheets("ログイン").Select If Range("F11").Value = "a8012661" Then Sheets("印章").Select ActiveSheet.Shapes("Picture 15").Copy Call 申請者捺印 End If If Range("F11").Value = "a6601456" Then Sheets("印章").Select ActiveSheet.Shapes("Picture 16").Copy Call 申請者捺印 End If If Range("F11").Value = "t9907028" Then Sheets("印章").Select ActiveSheet.Shapes("Picture 17").Copy Call 申請者捺印 End If If Range("F11").Value = "a7545410" Then Sheets("印章").Select ActiveSheet.Shapes("Picture 18").Copy Call 申請者捺印 End If If Range("F11").Value = "t9806047" Then Sheets("印章").Select ActiveSheet.Shapes("Picture 19").Copy Call 申請者捺印 End If If Range("F11").Value = "t0206030" Then Sheets("印章").Select ActiveSheet.Shapes("Picture 20").Copy Call 申請者捺印 End If  end if end sub Sub 申請者捺印() Sheets("報告票").Select Range("m3").Select ActiveSheet.Paste Range("a1").Select End Sub

  • 重複行を完全削除するエクセルのマクロ

    Sub sakujyo() Dim i, ii As Long For i = 1 To Range("a65336").End(xlUp).Row For ii = Range("a65336").End(xlUp).Row To i + 1 Step -1 If Cells(i, 2).Value = Cells(ii, 2).Value _ And Cells(i, 4).Value = Cells(ii, 4).Value _ And Cells(i, 5).Value = Cells(ii, 5).Value Then Dim iii As Byte iii = 1 Rows(ii).Delete Shift:=xlUp End If Next ii If iii = 1 Then Rows(i).Delete Shift:=xlUp iii = 0 Next i End Sub データーが下の表のように入っております。     A    B    C    E    F 1  1/26  a1234  fdsa  5000  C1 2  1/27  a4567  sdfa  4000  T2 3  1/28  a1234  dfsa  5000  C1 4  1/30  b4567  asdf  6600  A2 5  2/10  b4567  fsda  6600  A2 6  2/10  a1234  afds  5000  C1 B列、E列、F列が完全一致(重複1行目と3行目と6行目・4行目と5行目)で削除し結果的に2行目だけ残る方法がしたいのですが、このマクロですと少ないデータですとうまく動くのですが、『大量のデータを一気に削除出来ない』、『同じ重複が3つ以上のデータが多数ある場合データが削除されずに残ってしまう』エラーが出てしまいます。どうかお教えください。

  • 空白のセルを行削除する。EXCELマクロなのですが・・

    VBA初心者です。 データーをHPから、単純にコピーしてきて、 EXCELに貼り付けています。 フィルターをかけても、画像かなにかがセルに張り付いているのか、 空白行をすべて削除できません。 いろいろ試して(HPから、空白セルの行削除について書かれてあるマクロを貼り付けて)動いたのが、このVBAです。 しかし、遅いので、早いVBAに簡略できればいいのですが。。 大体、1000行ぐらいの文字を貼り付けて、3/1ぐらいが空白行です。A行のセルの空白のみを、削除したいのですが。  まったくの素人なので、わかりません。 どうかよろしくお願いいたします。 Sub 空白の削除() x% = Worksheets("sheet1").Range("A65536").End(xlUp).Row For i = x% To 1 Step -1 If Worksheets("sheet1").Cells(i, 1).Value = "" Then Worksheets("sheet1").Rows(i).Delete Next End Sub

  • 列幅、行の高さを指定するマクロ

    元マクロ初心者(今はほとんど忘れています)です。 列幅、行の高さを変更するマクロを以前作りました。 セルに指定する列幅を入力するのですが、 最近100以上の値の時はスキップされることに気づきました。 100以上の値でも処理されるようにするにはどうすればよいでしょうか。 Sub 列幅変更マクロ() ' ' Macro1 Macro ' マクロ記録日 : 2004/1/31 ユーザー名 : ' 列幅の変更 ' Keyboard Shortcut: Ctrl+l ' If MsgBox("→:列幅を変更します。右の方向にセル内の数値に従って処理しています。一番右のセルに半角で「@」を終わりの印として入力してください。", vbOK) = 1 Then Do Until ActiveCell.Value = "@" If ActiveCell.Value < 100 Then If ActiveCell.Value > 0 Then Selection.ColumnWidth = ActiveCell.Value End If End If ActiveCell.Offset(0, 1).Select Loop End If End Sub Sub 行の高さ変更マクロ() ' ' Macro2 Macro ' マクロ記録日 : 2004/2/1 ユーザー名 : ' 行の高さ変更 ' Keyboard Shortcut: Ctrl+p ' If MsgBox("↓:行の高さを変更します。下の方向にセル内の数値に従って処理しています。一番下のセルに半角で「@」を終わりの印として入力してください。", vbOK) = 1 Then Do Until ActiveCell.Value = "@" If ActiveCell.Value < 100 Then If ActiveCell.Value > 0 Then Selection.RowHeight = ActiveCell.Value End If End If ActiveCell.Offset(1, 0).Select Loop End If End Sub

  • 空白行の削除マクロについてご教示ください

    空白行の削除に、下記マクロを活用させていただいていますが、 見た目空白なのに削除されない行が時々残ってしまいます。 削除されなかったセルを「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

  • 空白行を削除するマクロ

    空白行を削除するマクロについて質問です。 「Aが空白の場合」ではなく「A~Lセルすべてが空白の場合」に行を削除したいです。 下記のマクロでは、Aが空白の場合に行がすべて削除されてしまいます。 Aが空白でも、BやLに数字や文字があれば、その行は残るようにしたいです。 このマクロをどう変化させれば、うまく作業が実行されますか? マクロは初心者です。よろしくお願いいたします。 ・・・・・・・・・・・・・・・・・・・・・・・・・・・・ sub macro1()  dim s as long  dim e as long  dim r as long  s = 5  e = range("A65536").end(xlup).row  for r = e to s step -1   if application.trim(cells(r, "A")) = "" then    cells(r, "A").entirerow.delete shift:=xlshiftup   end if  next r end sub

専門家に質問してみよう