VBA target を用いた複数行への入力方法

Targetを用いて入力のあったセルの隣の列に日時を記録する

エクセルにて入力があったセルの隣の列に日時を記録する機能をtarget.offsetを用いて作っています。
複数行への同時入力（コピーペースト）を行いたいのですが、エラーとなりました（二次元配列となるので「型が一致しません」と表示されます）。

実行時エラー’13'
型が一致しません。

これまでのコード(この状態だと複数行への同時の入力が可能でした）

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.column = 3 Then　'C列に入力がある場合、D列に時間を記録
　Application.EnableEvents = False
　Target.Offset(,1).value = Now
　Application.EnableEvents = True
End If

End Sub

試したこと：条件分岐の追加

このままだとC列の情報を削除した場合でもD列に記録されてしまうので、条件分岐を入れてC列が削除された時はD列の時間も同時に削除する仕様を試みました。

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.column = 3 Then　'C列に入力がある場合、D列に時間を記録

 If Target.Offset(,0).Value = "" Then
  Application.EnableEvents = False　'C列を削除した場合、D列は空白となる
  Target.Offset(,1).value = ""
  Application.EnableEvents = True
 Else
  Application.EnableEvents = False
  Target.Offset(,1).value = Now
  Application.EnableEvents = True
 End If

End If

End Sub

この仕様にすると一行に対する処理は実行できましたが、ドラッグしてコピーする際にエラーを起こしてしまいました。
Targetの仕様上、複数範囲（二次元配列）に対する処理が行えないとありましたので、何か対応策、代替策などないでしょうか。
宜しくお願い致します。

補足情報（FW/ツールのバージョンなど）

仕様：MicrosoftExcel　for Microsoft365 MSO

行動規範の内容に同意します

回答2件

ベストアンサー

これではどうでしょうか。

VBA
1Private Sub Worksheet_Change(ByVal Target As Range)
2    '
3    If Target.Column = 3 Then
4        '
5        Dim MyRange As Range
6        Dim TrRange As Range
7        Set TrRange = Range(Cells(Target.Row, 3), Cells(Target.Row + Target.Rows.Count - 1, 3))
8        '
9        For Each MyRange In TrRange
10            If MyRange.Value = "" Then
11                Application.EnableEvents = False
12                Cells(MyRange.Row, MyRange.Column + 1).Value = ""
13                Application.EnableEvents = True
14            Else
15                Application.EnableEvents = False
16                Cells(MyRange.Row, MyRange.Column + 1).Value = Now
17                Application.EnableEvents = True
18            End If
19        Next
20        '
21    End If
22    '
23End Sub

投稿2021/03/11 02:13

tosi

総合スコア553

N_kota

2021/03/12 22:52

有り難うございます！お陰様で解決しました！

行動規範の内容に同意します

For Each targetcell In Target.Cells とかではどうでしょう。

VBA
1Private Sub Worksheet_Change(ByVal Target As Range)
2    For Each Target In Target.Cells
3        If Target.Column = 3 Then  'C列に入力がある場合、D列に時間を記録
4            If Target.Offset(, 0).Value = "" Then
5                Application.EnableEvents = False  'C列を削除した場合、D列は空白となる
6                Target.Offset(, 1).Value = ""
7                Application.EnableEvents = True
8            Else
9                Application.EnableEvents = False
10                Target.Offset(, 1).Value = Now
11                Application.EnableEvents = True
12            End If
13        End If
14    Next
15End Sub