範囲内に空白行があれば

Question

最近VBAを始めました。
C11:H99999の範囲のセルに変更があった時、I列に更新日を表示。C列からH列がすべて空白の行は、I列も消すようにしたつもりなのですが、このマクロだと、C列からH列のどこかを消しただけで、I列も消えてしまいます。
C列からH列がすべて空白の行とのきだけ、I列を消すにはどうしたらいいのでしょうか。アドバイスください。


Private Sub Worksheet_Change(ByVal Target As Range)

  Dim MyRng As Range, R As Range
  Dim LastUpdated As Integer
  
  Set MyRng = Intersect(Target, Range("C11:H99999"))
  If MyRng Is Nothing Then Exit Sub
  
  LastUpdated = 9
 
  For Each R In MyRng.Rows
   If WorksheetFunction.CountA(MyRng) = "" Then
        Cells(R.Row, LastUpdated).Value = ""
   Else
        Cells(R.Row, LastUpdated).Value = Date
   End If
  Next

End Sub

tom04 · Accepted Answer

No.2です。

＞元ある値をコピーして複数新しい行を作成した時、複数の行をまとめて削除した時は・・・

そういった操作の場合もあるのですね。

Private Sub Worksheet_Change(ByVal Target As Range)
　Dim i As Long
　Dim myRng As Range
　　If Intersect(Target, Range("C:H")) Is Nothing Then Exit Sub
　　　'//▼とりあえず1000行程度限定//
　　　If Target((Target.Count)).Row - Target(1).Row > 1000 Then
　　　　MsgBox "範囲が広すぎます"
　　　　Exit Sub
　　　End If

'//▼ココから操作//
　　　For i = Target(1).Row To Target(Target.Count).Row
　　　　If i > 10 Then
　　　　　Set myRng = Cells(i, "C").Resize(, 6)
　　　　　　If WorksheetFunction.CountA(myRng) = 0 Then
　　　　　　　Cells(i, "I").ClearContents
　　　　　　Else
　　　　　　　Cells(i, "I") = Date
　　　　　　End If
　　　　End If
　　　Next i
End Sub

今度はどうでしょうか？

※　列全体などを範囲指定　→　Delete　のような操作を行うと、「応答なし」の状態になると思います。
今回は1000行程度限定としてみました。m(_ _)m

tom04 · Answer

こんばんは！

Private Sub Worksheet_Change(ByVal Target As Range)
　Dim myRng As Range
　　If Intersect(Target, Range("C:H")) Is Nothing Or Target.Count > 1 Then Exit Sub
　　　With Target
　　　　If .Row > 10 Then
　　　　　Set myRng = Range(Cells(.Row, "C"), Cells(.Row, "H"))
　　　　　　If WorksheetFunction.CountA(myRng) = 0 Then
　　　　　　　Cells(.Row, "I").ClearContents
　　　　　　Else
　　　　　　　Cells(.Row, "I") = Date
　　　　　　End If
　　　　End If
　　　End With
End Sub

こんな感じをお望みなのでしょうか？

※　当方の勘違いなら無視してください。m(_ _)m

Qchan1962 · Answer

こんばんは、先の質問に投稿しようとしたら締め切られていましたので、先のご質問内容での回答になります。ほぼ同じと判断しました。不明な点があれば補足をお願いします。一部の抜粋かと思いますが、 For Each R In MyRng.Rows Cells(R.Row, LastUpdated).Value = Date Next は、理にかなっていません。なぜなら、Set MyRngのRangeは、Changeなので単一アドレスなのではと思います。従ってFor Eachループは必要ないと思います。単純に　Cells(Target.Row, LastUpdated).Value = Date　で良いかと＞このマクロだと、C列からH列の値を削除したときもI列が変更されてしまいます。これを回避するなら、Cells(Target.Row, LastUpdated).Value = Dateの実行に条件（制限）をかけてはいかがでしょう。 If Target.Value <> "" Then　みたいな感じです。また、C列からH列の値を削除した時にI列の同じ行を削除したい場合は、If Target.Value <> "" Thenの否定側ElseにCells(Target.Row, LastUpdated).Value = ""を加えると　C11～H、、列のセルを空白にした時にI列の同じ行が空白になります。本題＞これを、C列からH列すべての行が空白の時はI列も空白にするというマクロを組むにはどこをどのように変更したらいいでしょうか？すべてがどこに掛かっているか、、理解してないかもですが If Target.Value <> "" Then　の否定側　ElseにCells(Target.Row, LastUpdated).Value = ""　のところに行すべてが空白かを調べ実行するようにすればよいですね。 Else If WorksheetFunction.CountBlank(Range("C" & Target.Row & "H" & Target.Row)) = Range("C" & Target.Row & "H" & Target.Row).Count Then Cells(R.Row, LastUpdated).Value = "" End If CountBlankは数式での空白も含まれます。 Targetを使うのが見にくいなら、ループで使わなくなった変数Rを使って Set MyRng = Intersect(Target, Range("C11:H99999"))を書き替え Set R = Intersect(Target, Range("C11:H99999")) Set R = Intersect(Target, MyRng)　でRにしても良いかな。 RにTargetをセットする形なので本当に必要か分かりませんが、、ご質問のコードの流れで、、以降　If R.Value <> "" Then　の様に　Rで良いかとこの辺は色々、、、纏めると　　Set R = Intersect(Target, Range("C11:H99999")) 　　If R Is Nothing Then 　　　　Exit Sub 　　Else 　　　　Application.EnableEvents = False 　　　　If R.Value <> "" Then 　　　　　　Cells(R.Row, LastUpdated).Value = Date 　　　　Else 　　　　　　Set MyRng = Range("C" & R.Row & ":H" & R.Row) 　　　　　　If Application.CountBlank(MyRng) = MyRng.Count Then 　　　　　　　　Cells(R.Row, LastUpdated).Value = "" 　　　　　　End If 　　　　End If 　　End If 　　Application.EnableEvents = True あと、セルへの書き込みがあるので、範囲から外れているので良いのですが、一応 Application.EnableEvents 　を加えました。

範囲内に空白行があれば

No.2です。

こんばんは！

こんばんは、

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング