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

このQ&Aのポイント
  • 空白行の削除に、下記マクロを活用させていただいていますが、見た目空白なのに削除されない行が時々残ってしまいます。
  • 削除されなかったセルを「Deleteキー」で空白にするとマクロが実行され、きちんと削除されます。
  • こういった、スペースか何かが入っていても、見た目空白なら削除するようにはできないでしょうか。
回答を見る
  • ベストアンサー

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

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

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

  • ベストアンサー
  • keithin
  • ベストアンサー率66% (5278/7940)
回答No.2

>スペースか何かが入っていても 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

hijtxa
質問者

お礼

早速のご教示ありがとうございました。 うまく削除できました。 早速、活用させていただきます。 また、よろしくお願いいたします。

その他の回答 (1)

  • tom04
  • ベストアンサー率49% (2537/5117)
回答No.1

こんにちは! おそらく・・・ >For Each c In Range("a" & 開始行 & ":a" & 最終行) の部分でお望みの結果にならないと思います。 上の行から下に向かって操作を行いますので、行が削除されるたびにFor~Next が1行ずつずれますので 本来削除したい行を通り越して次の行の操作に入ってしまうのが原因と思われます。 ↓のような感じにしてみてはどうでしょうか? Sub 削除2() Dim i As Long Dim 開始行 As Long Dim 最終行 As Long 開始行 = 5 最終行 = Range("a5000").End(xlUp).Row For i = 最終行 To 開始行 Step -1 If Cells(i, "A").Value = "" Then Rows(i).Delete End If Next End Sub ※ 行の挿入・削除は最終行から上に向かっての操作にした方が間違いないと思います。m(_ _)m

関連するQ&A

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

    空白行を削除するマクロについて質問です。 「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

  • VBAで空白行を削除する

    VBAでリストの空白行を削除するための適当なコードを探しているのですがどんぴしゃのものが中々見つかりません。ご教授下さい。 ブックBのシートBのリストにはA2~AN●まで値が入っています。 別のブックAからVBAで値を取り出し貼り付けています。 いくつかの方法を試しました。 (1)ブックを開いたときに空白行を削除 Sub Auto_Open() '空白行を削除 Dim lRow As Long Dim i As Long lRow = Cells(Rows.Count, 1).End(xlUp).Row Application.ScreenUpdating = False For i = lRow To 2 Step -1 If Cells(i, 1).Value = "" Then Range(i & ":" & i).Delete End If Next i Application.ScreenUpdating = True End Sub 5分以上砂時計のままで結局終わりません。 強制終了させ再度ブックを開くと空白行は削除されているのですが、こんな動作では使うことができません。 (2)ブックAの値を貼り付けた後、空白行を削除し上書き保存する Sub エクスポート() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Range(Cells(5, 7), Cells(79, 46)).Select Selection.Copy 'コピー Workbooks.Open Filename:="\\パス\ブックB.xlsm" '貼り付け先ファイルオープン Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '貼り付け Dim lRow As Long Dim i As Long lRow = Cells(Rows.Count, 1).End(xlUp).Row Application.ScreenUpdating = False For i = lRow To 2 Step -1 If Cells(i, 1).Value = "" Then Range(i & ":" & i).Delete End If Next i Application.ScreenUpdating = True  '空白行を削除 ActiveWorkbook.Save '上書き保存 Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub (3)空白行を削除の部分は以下のコードも試しました Worksheets("SheetB").Range("A1").Select Set currentCell = Worksheets("sheetB").Range("A1") Do While Not IsEmpty(currentCell) Set nextCell = currentCell.Offset(1, 0) If Not IsEmpty(currentCell) Then 'カレントセルが空白でなく、 If IsEmpty(nextCell) Then '次のセルが空白のとき nextCell.EntireRow.Delete End If End If Set currentCell = currentCell.Offset(1, 0) Loop '空白行削除 宜しくお願い致します。

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

    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列目の列が重複したときのみ重複した行をすべて削除させたいと思っております。どうぞお教えください。

  • 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

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

    こんにちは 今、現在、とある条件にあった行を削除するマクロ作っているのですが、 インターネットを調べてみると後ろから探索して、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

  • 空白のセルを行削除する。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

  • E列が空白のとき、その空白行を削除し、番号を振り直す

    windows7 Excel2003でマクロ勉強中です。 あるサイトにE列が空白のとき、その空白行を削除し、番号を振り直すという コードがありました。 自分で作った表(表の最上段の2行は項目名が入っています。)で  実行すると「Rangeメソッドは失敗しました。Globalオブジェクト」と エラーが出ます。エラーはでますが、処理自体は正しく実行されます。 このエラーの原因と回避するにはどうしたらよろしいでしょうか。 Sub E列が空白のとき、その空白行を削除し、番号を振り直す() Dim i As Long, j As Long '行削除の処理 For i = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1 If Range("A" & i).Value <> "" And IsNumeric(Range("A" & i).Value) = True Then If Range("E" & i).Value = "" Then Rows(i).Delete End If End If Next '番号振りなおし処理 '’’Range("A" & Rows.Count).End(xlUp).Offset(1).Select For i = 0 To Range("A" & Rows.Count).End(xlUp).Row If Range("A" & i).Value = "番号" Then j = 1 ・・・・・ここでエラー発生 If Range("A" & i).Value <> "" And IsNumeric(Range("A" & i).Value) = True Then Range("A" & i).Value = j j = j + 1 End If Next ActiveSheet.Protect End Sub

  • 指定した範囲で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

  • VBAで空白行を削除する。

    初めまして、VBA初心やです。なので具体的にご教授願います。環境WindoesXP SP3 EXCEL2010です。やりたい事Book1に空白行が沢山あるSheetが一枚あります。Sheetの中身は下記の通りです。 一行目に項目があります。n行目にも項目があります。nは、10個です。項目の下の行には、デターがあります。以下のようになっております。初めの位置はB2です。    B2    項目A 項目B 項目C 項目D・・・・・    項番1 データ1 データ2 データ3 データ4・・・・・・    項番2 データ1 データ2 データ3 データ4・・・・・・    項番3 データ1 空白  データ3 データ4・・・・・・    項番4 データ1 データ2  空白 データ4・・・・・・    項番5 データ1 データ2  空白 空白・・・・・・    項番6 データ1 データ2  空白 空白・・・・・・ 項番7 データ1 データ2  空白 空白・・・・・・ 項番8 空白   空白   空白 空白・・・・・・ ・    ・ ・     ・   ・     Bn    項目A 項目B 項目C 項目D・・・・・ 項番1 データ1 データ2 データ3 データ4・・・・・・ と続きます。この項番1は残して、項番8の様な空白セルが続く行だけ削除したいので、 以下のマクロを組みました。 Dim ii As Long Dim MaxRow(1 To 100) As Long Dim MaxCol As Long '============================ MaxRow(1) = Cells(Rows.Count, 2).End(xlUp).Row MaxRow(2) = Cells(Rows.Count, 21).End(xlUp).Row MaxRow(3) = Cells(Rows.Count, 22).End(xlUp).Row MaxRow(4) = Cells(Rows.Count, 23).End(xlUp).Row MaxCol = Range("IV4").End(xlToLeft).Column Application.ScreenUpdating = False '============================ For i = MaxRow(1) To 3 Step -1 '配列にした。 '============================ For j = 1 To MaxCol Step 1 '============================ If Cells(4, j).Value = "" Then GoTo Label22 'Else GoTo Label11 Label22: Range(4 & ":" & MaxCol).Delete Label11: Next j 'End If Next i Application.ScreenUpdating = True MsgBox "マクロが終了しました" End Sub しかし、ソートしてMaxRowの配列のいくつになるかを計算する処が判りません。 なので、空白行を削除できません。 ようするに、各項目(行)の空白セルがまちまちで(凹凸があり)、全ての項目が空白である処を探す事が出来ません。 何卒宜しくご教授願います。

  • エクセルVBAの別sheetの空白行削除について

    エクセルVBAでBOOK1のsheet1とsheet2とsheet3があり、 sheet1とsheet2の全ての情報をsheet3にコピーしてまとめるようにしました。 マクロを実行するには、Visual Basicを開いてF5を押しています。 それをsheet1かsheet2の中身の一部分でも変更すると そのときに自動的にマクロが実行されるようにしたいです。 sheet1とsheet2(sheet3は空白のまま)に Private Sub Worksheet_Change(ByVal Target As Range) Call マクロ() End Sub を入れ、 次に、標準モジュールに Sub マクロ() '下記よりsheet1とsheet2の内容をsheet3にコピーする Worksheets("sheet1").Range("C1:BE50").Copy _ Destination:=Workbooks("BOOK.xlsm").Worksheets("sheet3").Range("C1:BE50") Worksheets("sheet2").Range("C1:BE100").Copy _ Destination:=Workbooks("BOOK.xlsm").Worksheets("sheet3").Range("C51:BE150") '下記より上記sheet3の状態から余分な空白行を削除する Dim UsedCell As Range Dim Max_Row, RowCount As Integer Set UsedCell = ActiveSheet.UsedRange Max_Row = UsedCell.Cells(UsedCell.Count).Row Application.ScreenUpdating = False For RowCount = Max_Row To 1 Step -1 If Application.WorksheetFunction.CountA(Rows(RowCount)) = 0 Then Rows(RowCount).Delete End If Next Application.ScreenUpdating = True End Sub をやって、sheet1かsheet2のセルを変更すると エクセルが固まってしまいます。 デバックでは Rows(RowCount).Delete がよくないようです。 書き方が間違っているのでしょうか?

専門家に質問してみよう