[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『指定した範囲内で全てのセルが空白だった場合に行を削除する』（sato）
１週目という名のシートのE4からP11の範囲内で全てのセルが空白の行を検索し、それに該当する行を削除する。
というようなVBAを作ることは出来ますでしょうか？
図で表すと・・・
ＡＢＣＤＥＦＧＨＩＪＫＬＭＮＯＰ
１ 結合して文字入力
２縦縦縦
３ににに
４結結結 〇〇〇〇〇〇
５合合合
６ししし
７ててて 〇〇〇〇〇〇
８文文文
９字字字
10入入入
11力力力
このようになっている場合に、５・６・８～１１行目を削除したいです。
こういうことは出来るのでしょうか？
また、同じシートのE12からP19の範囲でも同じことをするようにしたい場合はどの様に書けばいいのでしょうか？
マクロ程度のことしか理解しておらず、ネットで検索してもどうしても解決出来ないので質問させて頂きました。
初心者丸出しの質問で申し訳ありませんが、助けて下さい。
質問に不足があったら、なにが不足しているのかをご教授して頂けたら幸いです。よろしくお願いいたします。
＜ 使用 Excel：Excel2016、使用 OS：unknown ＞
＞５・６・８～１１行目を削除したいです。
２・３も空白に見えるんですけど、それは削除しないのですか？
縦に結合しているのは、C列までですか？
横の結合は、Dからですか？ Dからどの列までですか？
横の結合は、1行ずつですね？（2行まとめての結合は無い）
＞E4からP11の範囲内で全てのセルが空白の行を検索し、それに該当する行を削除する。
済みません。上の記述からすると、横の結合てのは無いのですか？ すると、「結合して文字入力」はどんな意味があるんですか？
（半平太） 2018/04/18(水) 22:30
＞２・３も空白に見えるんですけど、それは削除しないのですか？
済みません。これを漠然と眺めていました m(__)m その質問は撤回します。 ↓ ＞「E4からP11の範囲内で全てのセルが空白の行を検索し、」
（半平太） 2018/04/18(水) 22:44
＞２・３も空白に見えるんですけど、それは削除しないのですか？
２行目には時間を表すために数字が入っています。
（正確な数字は上手く表現できないので、下の図ではダミーの数字を入れました。）
３行目は作業中に数字（または文字）を手入力する必要のある行です。
なので２・３行目は削除しません。
↓
再度書き込みありがとうございます。念のためにご返答しておきます。
＞縦に結合しているのは、C列までですか？
縦に結合しているのは、C列までです。
詳しく書くと・・・
ＡＢＣＤＥＦＧＨＩＪＫＬＭＮＯＰ
１＜結 合 し て 文 字 入力＞
２ １２３４５６７８９１２３
３＾＾
４縦縦＾ 〇〇〇〇〇〇
５ 結
６にに合
７ し 〇〇〇〇〇〇
８ て
９結結文
10 字
11 ｖ
12合合＾〇〇〇〇
13 結
14 合
15ししし
16 て 〇〇〇〇〇〇
17 文
18てて字
19 ｖ
20文文＾〇〇〇〇
21 結
22字字合
23 し
24入入て
25 文 〇〇〇〇〇〇
26力力字
27ｖｖｖ
のようになっています。
＜＞内が結合しているセルの範囲を表しています。
＞済みません。上の記述からすると、横の結合てのは無いのですか？
１行目が横に結合されています。
＞すると、「結合して文字入力」はどんな意味があるんですか？
横の結合には表のタイトルのようなものが入力されています。
縦の結合には日付や曜日、場所が入力されています。
返答がちゃんとできていなかったら申し訳ありません。
（sato） 2018/04/18(水) 23:04
＞横の結合は、Dからですか？ Dからどの列までですか？
上記の新しい図でわかりますでしょうか？
＞横の結合は、1行ずつですね？（2行まとめての結合は無い）
横の結合は１行ずつしかありません。
よろしくお願いいたします。
（sato） 2018/04/18(水) 23:07
やってみたら、結合は関係ないみたいです。下のでテストしてみてください。
Sub Del()
Dim rngToProc As Range
Dim rngToDelete As Range
Dim RW As Long
For RW = 4 To 11 ’19行までやりたいなら、11を19に変える
With Sheets("１週目").Range("E:P").Rows(RW)
If Application.CountA(.Cells) = 0 Then
If rngToDelete Is Nothing Then
Set rngToDelete = .Cells(1, 1)
Else
Set rngToDelete = Union(rngToDelete, .Cells(1, 1))
End If
End If
End With
Next RW
If Not rngToDelete Is Nothing Then
rngToDelete.EntireRow.Delete
End If
End Sub
（半平太） 2018/04/18(水) 23:12
「E4からP11の範囲の文字以外の数式を選択し、該当のセルの数式と値をクリア（マクロ記憶をしてみたら下記のように記憶されていました）」してから先ほどの作業をする場合にはどのようにVBAを追記すればいいのでしょうか？
Sub Macro2()
'
' Macro2 Macro
'
'
Range("E4:P11").Select
Selection.SpecialCells(xlCellTypeFormulas, 21).Select
Selection.ClearContents
End Sub
また、「同じシートのE30からP53の範囲でも数式と値をクリアしてから、上記の作業」をしたい場合、同じVBAに纏めることはできますでしょうか？
先ほどの図が30行目から繰り返されるのですが、28行目と29行目が空白行でも削除したくない為、作業を分ける必要があると勝手に判断しましたが、どうなのでしょうか？
色々と追加でお伺いして申し訳ありません。
お時間があれば返答して頂ければ幸いです。
（sato） 2018/04/18(水) 23:35
Sub Del()
Dim rngToProc As Range
Dim rngToDelete As Range
Dim RW As Long
'ここに入れる
'まずは "１週目"のシート名を限定した方がいいです。
'慣れたら、Selectしない方法も出来るようにしてください。
'（マクロの記録は手操作がベースなので、Selectのオンパレードになるのはやむを得ない面があります）
'数式が全然ないと、エラーになりますので、将来的にはその対策も工夫していただく必要があります。
Sheets("１週目").Select
Sheets("１週目").Range("E4:P11").Select
Selection.SpecialCells(xlCellTypeFormulas, 21).Select
Selection.ClearContents
For RW = 4 To 53
'＞28行目と29行目が空白行でも削除したくない為、
'たった2行分のことなら
If RW = 28 Then '28になったら強制的にRWを30へすっ飛ばす
RW = 30
End If
With Sheets("１週目").Range("E:P").Rows(RW)
If Application.CountA(.Cells) = 0 Then
If rngToDelete Is Nothing Then
Set rngToDelete = .Cells(1, 1)
Else
Set rngToDelete = Union(rngToDelete, .Cells(1, 1))
End If
End If
End With
Next RW
If Not rngToDelete Is Nothing Then
rngToDelete.EntireRow.Delete
End If
End Sub
（半平太） 2018/04/18(水) 23:53
この先はもしお暇でしたらの返答で結構です。
何度も追加質問して申し訳ありません。
もし繰り返しが1回ではなく2回になった場合、28・29行目だけではなく、54・55行目も同じように飛ばしたい場合は
If RW = 28 Then '28になったら強制的にRWを30へすっ飛ばす
RW = 30
の部分を追加する形で変更すれば対応できるのでしょうか？
もしお時間ありましたらお教え下さい。
（sato） 2018/04/19(木) 00:19
＞もし繰り返しが1回ではなく2回になった場合、28・29行目だけではなく、54・55行目も同じように飛ばしたい場合は ＞ If RW = 28 Then '28になったら強制的にRWを30へすっ飛ばす ＞ RW = 30 ＞の部分を追加する形で変更すれば対応できるのでしょうか？
2つのケースだけなら↓
If RW = 28 or RW = 54 Then '28又は54なら強制的に、RW+2 として、2行すっ飛ばす
RW = RW + 2
もっと沢山のケースがあるなら、その規則性を喝破して、臨機応変に処理してください。
（半平太） 2018/04/19(木) 09:36
Sub test()
Dim rngArea As Range
Dim a As Range
Dim r As Range
Dim rngTarget As Range
Set rngArea = Worksheets("１週目").Columns("E:P").SpecialCells(xlCellTypeFormulas)
For Each a In rngArea.Areas
On Error Resume Next
r.SpecialCells(xlCellTypeFormulas, xlErrors + xlLogical + xlNumber).ClearContents
On Error GoTo 0
For Each r In a.Rows
If WorksheetFunction.CountA(r) = 0 Then
If rngTarget Is Nothing Then
Set rngTarget = r
Else
Set rngTarget = Union(rngTarget, r)
End If
End If
Next
If Not rngTarget Is Nothing Then rngTarget.Delete Shift:=xlShiftUp
Next
End Sub
（まっつわん） 2018/04/19(木) 11:18
まっつわん様
ご返答ありがとうございます。
半平太様のご返答で解決はしましたが、こちらの方法も勉強の為に試してみます。
ありがとうございます！！
（sato） 2018/04/19(木) 13:00
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.