社会人&学生におすすめする色彩検定の勉強術

いつもお世話になっております。

下記のVBAのプログラムは私が書籍を参考に【I列】にデータが
入力された際、【L列】に日付を反映させるプログラムになりますが、
こちらに複数セルデリートの処理を加えたく質問させていただきました。

Private Sub Worksheet_Change(ByVal Target As Range)
Select Case Target.Column
Case 9 'I列の入力時、L列に日付を入力
If Target.count > 1 Then Exit Sub
If Target.Value = "" Then '(複数セル選択時のエラー対策)
Cells(Target.Row, 12) = ""  'I列のデータをクリアするとL列もクリア
Else
Cells(Target.Row, 12) = Format(Now(), "YYYY/MM/DD")
End If
End Select
End Sub

Cells(Target.Row, 12) = ""
こちらの構文ではI列のデータを消した際、L列のデータも消えるのですが
処理が1セルずつのため複数セルを一度にデリートなどの構築は可能なのでしょうか?

色々お調べしたところTargetの指定に対し複数セルが選ばれた際にエラーとなる為、
セルが1以上だった場合に処理を止める If Target.count > 1 Then Exit Sub
こちらの構文が複数セルをデリートしても消せない原因だと思うのですが
私の知識不足によりこれ以上のことが分からず困っている次第です。

ご教示いただけると幸いです。
よろしくお願いいたします。

教えて!goo グレード

A 回答 (4件)

おはようございます


申し訳ないです。;;
色々な選択の仕方を考えすぎました。。

こちらでどうでしょう。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
Application.ScreenUpdating = False
Application.EnableEvents = False
For Each c In Selection
  Select Case c.Column
  Case 9
'I列の入力時、L列に日付を入力
   If Target(1).Value = "" Then '(複数セル選択時のエラー対策)
    Cells(c.Row, 12) = "" 'I列のデータをクリアするとL列もクリア
   Else
    If Target.Column = 9 And Target.Value <> "" Then
    Cells(Target.Row, 12) = Format(Now(), "YYYY/MM/DD")
    GoTo EndLabel
    End If
   End If
  End Select
Next
EndLabel:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
    • good
    • 0
この回答へのお礼

Qchan1962さんが作成していただいたこちらの
VBAで理想の処理が叶い活用させていただきます。
この度はありがとうございました。

今後も何かとこちらにお世話になるかと存じますが、
その際は何卒よろしくお願いいいたします。

お礼日時:2021/02/20 23:26

#1,2です。

連続投稿申し訳ありません。
自身で書いたものが気に食わなく、サンプルを再提示いたします。
原型を大分変えてしまいました。
入力時、削除時共に単セルまたは、複数セルを選択した場合を想定しています。
参考程度に
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
Application.ScreenUpdating = False
Application.EnableEvents = False
For Each c In Selection
Select Case c.Column
Case 9
'I列の入力時、L列に日付を入力
If Target(1).Value = "" Then '(複数セル選択時のエラー対策)
Cells(c.Row, 12) = "" 'I列のデータをクリアするとL列もクリア
Else
If c.Value <> "" Then
Cells(Target.Row, 12) = Format(Now(), "YYYY/MM/DD")
GoTo EndLabel
End If
End If
End Select
Next
EndLabel:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

ステップ実行(デバッグ)により途中で終了した場合、
Application.EnableEvents = Trueが実行されず、イベントが実行されなくなります。
念のため下記を実行すれば、シートイベントを復旧出来ます。
Sub a()
Application.EnableEvents = True
End Sub
    • good
    • 0
この回答へのお礼

Qchan1962さん回答ありがとうございます。

サンプルを構築してくださりありがとうございます。

早速ですがこちらのプログラムを使わせていただいたところ、
I列にデータを入力した際のL列の挙動について質問がございます。

I列に値を入力した際にはL列の日付はまだ反映はされず、
もう一度I列に戻り値を入力した際ここでL列に入力が
行われるのですが、こちらは何か私の設定が間違っているのでしょうか?

度々の質問となり申し訳ございませんが、よろしくお願いいたします。

お礼日時:2021/02/20 07:35

#1です


ごめんなさい。サンプルには、バグがあります。
下記の様に修正してください。

バグ
If Target.Count > 1 Then Exit Sub '入力時

修正
If Target.Count > 1 Then GoTo EndLabel

追加
End Select の下

EndLabel:

Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
    • good
    • 0

こんばんは、


If Target.count > 1 Then Exit Sub は確かにトリガーセルが1つでないと実行から抜けるものだと思いますが、Targetが1つであっても処理範囲は1つとは限りませんね。繰り返し処理や.Reziseで範囲を広げる事が可能です。

あと、ご質問と少し違う部分ではありますが、
Worksheet_Changeでは
Application.EnableEvents = Falseを実行して
処理を行い、処理を終了したら
Application.EnableEvents = True
するようにした方が良いでしょう。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
Application.ScreenUpdating = False
Application.EnableEvents = False
Select Case Target.Column
Case 9    'I列の入力時、L列に日付を入力
  If Target(1).Value = "" Then '(複数セル選択時のエラー対策)
   If Target.Count >= 1 Then
    For i = 0 To Selection.Count - 1
    If Selection(i + 1).Column = 9 Then '横方向選択時の対処
     Cells(Target.Row + i, 12) = "" 'I列のデータをクリアするとL列もクリア
    End If
    Next
   End If
  Else
   If Target.Count > 1 Then Exit Sub '入力時
   Cells(Target.Row, 12) = Format(Now(), "YYYY/MM/DD")
  End If
End Select
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

少し分かり難いところもあると思いますが、
調べながら作成したのであれば、サンプルを辿りながら調べれば
分かると思います。
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

教えて!goo グレード

このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング