[[20060831181930]]　『A列のセルがブランクであれば行ごと削除』（mutsu）　ページの最後に飛ぶ

『A列のセルがブランクであれば行ごと削除』（mutsu）

 お世話になります。
 A列のセルにブランクがあれば、その行ごと削除をしたいので、色々検索し以下の
 マクロを使ってみました。

 Sub test()
        For Each c In Range("A1:A200")
            If IsEmpty(c) Then c.EntireRow.Delete
        Next
    End Sub

 しかし、これですと2行連続でA列がブランクの場合、上の行のみ削除されます。
 どこをどのように変更すれば、2行連続で削除できますか?

 行の削除でFor Each Loop　はそのような結果になります。
 一般的には、下からLoopでしょう、

 Sub Sample()
 Dim i As Long
 For i = 200 To 1 Step -1
    If IsEmpty(Cells(i,"a")) Then Rows(i).Delete
 Next
 End Sub

 For Each Loop での解決案(高速)

 Sub test()
 Dim r As Range, txt As String
 Again:
    For Each r In Range("a1",Range("a" & Rows.Count).End(xlUp))
      If IsEmpty(r) Then txt = txt & r.Address(0,0) & ","
      If Len(txt) > 245 Then
         Range(Left(txt,Len(txt) -1)).EntireRow.Delete
         txt = Empty
         GoTo Again
      End If
    Next
    If Len(txt) Then Range(Left(txt,Len(txt)-1)).EntireRow.Delete
 End Sub
 (seiya)

 seiya様、ありがとうございます。
 上記方法で、エラーが出てしまいました。
 Range(Left(txt),Len(txt) -1).EntireRow.Delete←部分の「Left」が反転して
 コンパイルエラー：因数は省略できません　と出ます。
 変換等が必要なのでしょうか？（mutsu）

 失敗!

 Range(Left(txt,Len(txt)-1).EntireRow.Delete

 です。（コード修正済み）
 (seiya)

 seiya様、何度も申し訳ありません。＞＜;;
 今度は、実行時エラー1004です。
 Rangeメソッドは失敗しました。_Globalオブジェクト　と出ています。
 お願いいたします。（mutsu）

 横から失礼します。
 これでうまくいきませんか？ 数式で返した "" には反応しませんが。
（純丸）(o^-')b

 Sub test()
   On Error Resume Next   '空白が無かった時のため
   Range("A1:A200").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
 End Sub

 ↑　は数式が無ければ一番早いですね。

 コード変更しましたので...(seiya)

 純丸様、残念ながら数式で値を返しています＞＜
 ありがとうございました。
 ほかに機会があれば、使わせいただきます。

 seiya様、本当に申し訳ありません。前回と同じエラーが最下行で出ました。
 If Len(txt) Then Range(Left(txt,Len(txt)-1)).Delete　の部分です。
 データベースに問題ありですか？（mutsu）

 ごめんなさい！朝から大ボケ...LOL

 txt = txt & r.Address(0,0) & "," (コード変更済み)
 (seiya)

 ちょっと質問です。SpecialCells(xlCellTypeBlanks) に反応しないセルは、
 IsEmpty でも False なのではないでしょうか？
 私が何か、勘違いしてます？
（純丸）(o^-')b

 あっ！そうだ
 If r.Value = ""
 としないと... (seiya)

 でしょ？ だから、一番最初に提示されているマクロが IsEmpty なんで、それで数式で
 値を返してるとコメントされているので？？？なのです。
 ちなみに r.Value = "" なら、こんなのも考えられます。元々の空白も削除されちゃいますが。
（純丸）(o^-')b

 Sub test()
   Dim r As Range
   Dim myr As Range
   On Error Resume Next
   Set myr = Range("A1:A200")
   For Each r In myr
      If r.Value = "" Then r.ClearContents
   Next r
   myr.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
 End Sub

 Ahhh...

 ありあり...大いにありですよ。(seiya)

あ！すみません。ちょっと仕事が立て込んでいまして、覗けませんでした。

 純丸さん、seiyaさん色々ありがとうございます。
 「あり」ですね。大いに「あり」でした。
 ご提示いただいたマクロをテスト用の数式のないデータで起動させていました。
 本当に間が抜けててすみません＞＜.。

 純丸さんのマクロを使わせいただいたところ、ばっちり動いてくれました。
 そして、とても図々しいのですがもう一つお聞きしたいことが・・・
 A～C列の3列がブランクの場合のみ、行ごと削除をしたい場合はどのようになるのでしょうか？

 取り合えず、If r.Value = "" Then r.ClearContents　を
 If r.Value = "" And r.Offset(0, 1).Value = "" And r.Offset(0, 2).Value = "" Then r.ClearContents
 に、したらどうでしょう。
（純丸）(o^-')b

 参考出品。
「行ごと削除をしたい」って、行削除でよいのかしら。
　
 Sub TEST_20060903()
     Dim i As Long
     For i = 1 To 3
         Range("A1:C200").AutoFilter _
             field:=i, Criteria1:=""
     Next i
     On Error Resume Next
     Range("A2:C200").SpecialCells(xlCellTypeVisible).Select
     If Err.Number = 1004 Then
         MsgBox "該当セルがありません。"
     ElseIf Err.Number = 0 Then
         Selection.Delete shift:=xlUp
     Else
         MsgBox "想定外のエラー"
     End If
     Range("A1:C200").AutoFilter
     Err.Clear
     Range("A1").Select
 End Sub
　
(みやほりん)(-_∂)b　一応、一行目だけは残すようにしてありますけど。

 みやほりんさん、純丸さん、ありがとうございます。
 思った通りのデータが出来上がります。
 助かりました。
 応用できるよう、勉強します。（mutsu）

コメント返信：

[ 一覧(最新更新順) ]

[[20060831181930]] 『A列のセルがブランクであれば行ごと削除』（mutsu） ページの最後に飛ぶ

[[20060831181930]]　『A列のセルがブランクであれば行ごと削除』（mutsu）　ページの最後に飛ぶ