こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

続・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桁の整数値しか入らないようにしたいけど整数値限定は可能?・・・その整数値を貼り付ける際日付型へのフォーマットが難しい

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

投稿日時 - 2009-01-22 23:18:30

QNo.4652842

すぐに回答ほしいです

質問者が選んだベストアンサー

>・複数セルを選択して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

投稿日時 - 2009-01-23 00:04:46

お礼

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

投稿日時 - 2009-01-31 01:07:33

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(2)

ANo.1

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
といった具合でしょう ・・・

投稿日時 - 2009-01-22 23:45:32

お礼

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

投稿日時 - 2009-01-31 01:07:03

あなたにオススメの質問