続・VBAでセルに値が入ったときにイベントを起こしたい

質問

http://oshiete1.goo.ne.jp/qa4650025.htmlで教えていただきありがとうございました。大変分かりやすい解説でした。
こういうことが出来るんだーとわかりもっと使いやすいように仕様を変えた方がいいと気づき新たに書き込んでみました。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long

' 変更したセルに値が入った場合条件成立
If Trim(Target.Value) <> "" Then

' 行番号が10以上65530以内のとき条件成立
If Target.Row >= 10 And Target.Row <= 65530 Then

' BCD列で、5の倍数の行のとき条件成立
If (Target.Column = 2) And (Target.Row Mod 5) = 0 Then
If Target.Value <> "" Then
For i = 0 To 4
Target.Copy
Target.Offset(i, 10).PasteSpecial Paste:=xlPasteValues
Next
Worksheets("Sheet4").Range("A2:K6").Copy Target.Offset(5, -1)
End If
ElseIf (Target.Column = 3) And (Target.Row Mod 5) = 0 Then
If Target.Value <> "" Then
For i = 0 To 4
Target.Copy
Target.Offset(i, 10).PasteSpecial Paste:=xlPasteValues
Next
End If
ElseIf (Target.Column = 4) And (Target.Row Mod 5) = 0 Then
If Target.Value <> "" Then
For i = 0 To 4
Target.Copy
Target.Offset(i, 10).PasteSpecial Paste:=xlPasteValues
Next
End If
Else
Exit Sub
End If
End If
End If
End Sub
ここまでは何とか出来たのですが問題点があります・・・
・複数セルを選択してDELすると実行時エラー13が出ます。（別の回答にあったやつですが・・・）
・別シートより範囲指定したセルをコピーして張り付けるときも出ます。
・B列には6桁の整数値しか入らないようにしたいけど整数値限定は可能？・・・その整数値を貼り付ける際日付型へのフォーマットが難しい

などあります。ヒントをいただけないでしょうか？

回答No.2

hana-hana3 · ベストアンサー

＞・複数セルを選択してDELすると実行時エラー13が出ます。（別の回答にあったやつですが・・・）
・別シートより範囲指定したセルをコピーして張り付けるときも出ます。

おまじないを加えます。
Application.EnableEvents：イベントの停止と再開
Selection.Cells.Count ：選択されたセルの数

＞・B列には6桁の整数値しか入らないようにしたいけど整数値限定は可能？・・・その整数値を貼り付ける際日付型へのフォーマットが難しい

意味が良く解りませんが・・・。
桁数や形式を入力規則で設定するのは駄目なのでしょうか？

Private Sub Worksheet_Change(ByVal Target As Range)

If Selection.Cells.Count <> 1 Then Exit Sub
Application.EnableEvents = False

If Trim(Target.Value) <> "" And Target.Row Mod 5 = 0 And Target.Row >= 10 And Target.Row <= 65530 Then
If (Target.Column = 2) Then
Target.Copy
Range(Target.Offset(0, 10), Target.Offset(4, 10)).PasteSpecial Paste:=xlPasteValues
Worksheets("Sheet4").Range("A2:K6").Copy Target.Offset(5, -1)
ElseIf Target.Column = 3 Or Target.Column = 4 Then
Target.Copy
Range(Target.Offset(0, 10), Target.Offset(4, 10)).PasteSpecial Paste:=xlPasteValues
End If
Application.CutCopyMode = False
End If

Application.EnableEvents = True

End Sub

お礼

ありがとうございます！
なんとか形になってきました

回答No.1

redfox63

Worksheet_Changeイベントだけで処理しようとすると無理が出そうです

今回の処理内容別処理に振り分けて Worksheet_Changeから呼ぶようにしましょう

Sub Worksheet_Change(Target as Range)
　　dim r as range
　　for each r in target
　　　　MyProc r
　　next
End Sub

Sub MyPorc(Target as Range)
　　Dim i As Long

　　' 変更したセルに値が入った場合条件成立
　　If Trim(Target.Value) <> "" Then

　　　　' 行番号が10以上65530以内のとき条件成立
　　　　If Target.Row >= 10 And Target.Row <= 65530 Then

　　　　' BCD列で、5の倍数の行のとき条件成立
　　　　if (Target.Column >= 2) and (Target.Column <= 4) then
　　　　　　If (Target.Row Mod 5) = 0 Then
　　　　　　　　If Target.Value <> "" Then
　　　　　　　　　　For i = 0 To 4
　　　　　　　　　　　　Target.Copy
　　　　　　　　　　　　Target.Offset(i, 10).PasteSpecial Paste:=xlPasteValues
　　　　　　　　　　Next
　　　　　　　　　　if (Target.Column = 2) Then
　　　　　　　　　　　　Worksheets("Sheet4").Range("A2:K6").Copy Target.Offset(5, -1)
　　　　　　　　　　End If
　　　　　　　　End If
　　　　　　Else
　　　　　　　　Exit Sub
　　　　　　End If
　　　　End If
　　End If
End Sub
といった具合でしょう ・・・

お礼

ありがとうございます！
なんとか形になってきました