[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『対象列全てが空白である行の削除マクロ』(あらくま)
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
(マナ) 2019/03/18(月) 23:04
(マナ) 2019/03/18(月) 23:18
(マナ) 2019/03/18(月) 23:22
ここがよく理解できません。
対象範囲は、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
UNIONを使ったり、AdvancedFilterを使ったり、配列を使ったり、大変勉強になりました。
また、複数セルが未入力であることの確認方法も、勉強になりました。
無事、考えていた動作を実現できました。
(あらくま) 2019/03/19(火) 22:05
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.