[[20190318222122]] 『対象列全てが空白である行の削除マクロ』(あらくま) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『対象列全てが空白である行の削除マクロ』(あらくま)

    A    B    C    D    E
 1  a	あ              1
 2  b	い		2
 3 		   S	3
 4  c	う		4
 5 	      V         5
 6  d			6
 7			7
 8  e	え		8
 9  f	お    W		9
10  g	か		10
11  h		   S	11
12	き		12
13  i	く		13
14			14
15  j	け		15
16  10	 9    2    
17                 2

上記のような表からA列,B列,C列,D列の全てのセルが空白である行、
例えば7行目や14行目を削除するマクロはどのようなものになりますか。
できれば、1行ずつ削除するのではなく、削除すべき行情報をある変数などに
集めておいて、いっきに削除する方法をお教えいただけるとありがたいです。
なお、15行目と16行目との間に、作業の進行とともに行が挿入されていき、
削除判定対象行となっていく仕様です。
ネット等で調べてみても、空白セルが一つでもある行が削除されてしまう
ものしか見つけられず、困っています。

< 使用 Excel:Excel2013、使用 OS:Windows7 >


念の為、確認しますが、手操作(オートフィルタ)が簡単そうですが
それでも、マクロですか?

(マナ) 2019/03/18(月) 22:51


マナさん、早速ありがとうございます。
エクセル操作に不慣れな者が扱うこともあって、指定のマクロボタン操作だけで
よいようにしたいのです。
ぜひ、マクロでお願いしたいのですが・・・

(あらくま) 2019/03/18(月) 22:59


1行目に、見出しはありますか?

(マナ) 2019/03/18(月) 23:04


1行目の見出しを示すのを忘れていました。
あります。
ですので、私の示した表は1行ずつ下に移ります。
(あらくま) 2019/03/18(月) 23:13

E列が空白になることはありますか?

(マナ) 2019/03/18(月) 23:18


ごめんなさい。提示のサンプルみたらわかることでした。

(マナ) 2019/03/18(月) 23:22


>なお、15行目と16行目との間に、作業の進行とともに行が挿入されていき、
>削除判定対象行となっていく仕様です

ここがよく理解できません。
対象範囲は、15行目までの固定という意味でしょうか?
,

(マナ) 2019/03/18(月) 23:25


もう遅いので、ここまでにさせてください。

こんな手順で考えるとよいです。
「マクロの記録」も参考になるかもしれません。

1)列A:Eを選んで、オートフィルタ
2)A列で、空白セルを抽出
3)B列で、空白セルを抽出
4)C列で、空白セルを抽出
5)D列で、空白セルを抽出
6)見出し以外の抽出された行を削除
7)オートフィルタ解除

(マナ) 2019/03/18(月) 23:33


 >できれば、1行ずつ削除するのではなく、削除すべき行情報をある変数などに 
 >集めておいて、いっきに削除する方法をお教えいただけるとありがたいです。 
 UNION使います。
    Sub 行一括削除()
        Dim i As Long
        Dim r As Range
        For i = 2 To Cells(Rows.Count, "E").End(xlUp).Row 'E列の一番最後のデータまで
            'COUTNA関数でA〜D列が何も入力されていないことをチェック
            If WorksheetFunction.CountA(Rows(i).Columns("A:D")) = 0 Then
                '削除対象の行を変数 r にまとめる
                If r Is Nothing Then
                    Set r = Rows(i)
                Else
                    Set r = Union(r, Rows(i))
                End If
            End If
        Next i
        '変数 r が空っぽでなければ、削除
        If Not r Is Nothing Then
            r.Delete xlUp
        End If
    End Sub

(稲葉) 2019/03/19(火) 08:24


 >できれば、1行ずつ削除するのではなく、削除すべき行情報をある変数などに 
 >集めておいて、いっきに削除する方法をお教えいただけるとありがたいです。
 AdvancedFilter使用。
 一気に削除はしますが、変数は使用しません。
 どうしても、というならSpecialCells xlVisible等で

 Sub test()
     Dim rng As Range
     With Cells(1).CurrentRegion
         Set rng = .Offset(, .Columns.Count + 1).Range("a1:a2")
         rng(2).Formula = "=countblank(a2:d2)=4"
         .AdvancedFilter 1, rng
         .Offset(1).EntireRow.Delete
         .Worksheet.ShowAllData
         rng.Clear
     End With
 End Sub
(seiya) 2019/03/19(火) 08:58

 配列使用。。。^^;。。。です。

 Option Explicit
Sub main()
    Dim i As Long
    Dim buf As Variant
    Dim x() As Long
    Dim y() As Long
    Dim my As Long
    Dim mx As Long
    Dim cnt As Long
    Dim WF, D
    Set D = CreateObject("Scripting.Dictionary")
    Set WF = WorksheetFunction
    With Worksheets("Sheet1")
        For i = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
            ReDim Preserve x(cnt)
            x(cnt) = .Cells(i, .Columns.Count).End(xlToLeft).Column
            cnt = cnt + 1
        Next
        cnt = 0
        For i = 1 To .Cells(i, .Columns.Count).End(xlToLeft).Column
            ReDim Preserve y(cnt)
            y(cnt) = .Cells(.Rows.Count, i).End(xlUp).Row
            cnt = cnt + 1
        Next
        my = WF.Max(y)
        mx = WF.Max(x)
        cnt = 0
        buf = .Range(.Cells(1, 1), .Cells(my, mx))
        For i = 1 To UBound(buf, 1)
            If buf(i, 1) <> "" Or buf(i, 2) <> "" Or buf(i, 3) <> "" Or buf(i, 4) <> "" Then
                D(cnt) = Array(buf(i, 1), buf(i, 2), buf(i, 3), buf(i, 4), buf(i, 5))
                cnt = cnt + 1
            End If
        Next
        .Copy before:=Worksheets(1)
        With ActiveSheet
            .UsedRange.Clear
            For i = 0 To D.Count
                .Cells(i + 1, 1).Resize(1, 5) = D(i)
            Next
        End With
    End With
End Sub

 一部シート指定が抜けていましたので修正。2019/03/19 : 10:12
(隠居じーさん) 2019/03/19(火) 09:40

稲葉さん、seiyaさん、隠居じーさん、ご教示ありがとうございました。
勤務の関係で、確認が遅い時間となってしまいました。

UNIONを使ったり、AdvancedFilterを使ったり、配列を使ったり、大変勉強になりました。
また、複数セルが未入力であることの確認方法も、勉強になりました。

無事、考えていた動作を実現できました。
(あらくま) 2019/03/19(火) 22:05


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.