[[20170410161206]]　『Worksheet_Change連結について』（satosi）　ページの最後に飛ぶ

『Worksheet_Change連結について』（satosi）

マクロ初心者です。
プロシージャが２つあり、つなぎ方だと思いますが
＝＝＝＝＝＝から下が動作してくれません？
アドバイスお願いします。
Private Sub Worksheet_Change(ByVal Target As Range)

  Dim セル代入 As Range

     With Target
        If .Count > 1 Then Exit Sub
        If .Value = "" Then Exit Sub
        If Intersect(Target, Range("C20:C500")) Is Nothing Then Exit Sub

        If .Value < Range("C20").Value Then
            MsgBox "日付が起算日（C20セル）以前です？確認してください。" _
            & vbCrLf & vbCrLf & "C28セル以前は集計対象外になるため入力不可です。"
        Application.EnableEvents = False
        .Value = ""
        Application.EnableEvents = True
        End If
    End With
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

  If Intersect(Target, Range("H20:H500")) Is Nothing Then
    Exit Sub
  End If
  Application.EnableEvents = False
  For Each セル代入 In Target
    If IsEmpty(セル代入.Value) Then
      セル代入.Offset(, -5).ClearContents
    Else
      If セル代入.Offset(, -5).Value = "" Then
        If Day(Date) >= 8 Then
          セル代入.Offset(, -5).Value = Format(DateSerial(Year(Date), Month(Date) + 1, 5), "gee.mm.dd")
        Else
          セル代入.Offset(, -5).Value = Format(DateSerial(Year(Date), Month(Date), 5), "gee.mm.dd")
        End If
      End If
    End If
      Next
  Application.EnableEvents = True
End Sub
よろしくお願いします。

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

 ↓の条件に合致したからExit Subしているのでは？

  If Intersect(Target, Range("H28:H500")) Is Nothing Then
     Exit Sub
   End If

 動作していない、というのはどのように確認されましたか？
（カリーニン） 2017/04/10(月) 16:26

 参考になると思います。

http://kabu-macro.com/vba_apply/vba_ifthen.html
（カリーニン） 2017/04/10(月) 16:29

 そもそも
 >If Intersect(Target, Range("C20:C500")) Is Nothing Then Exit Sub
 この条件でRange("H20:H500")の範囲は最初のうちに終了になってしまうが。
（ねむねむ） 2017/04/10(月) 16:31

（カリーニン）さん
ありがとうございます。

 ＞動作していない、というのはどのように確認されましたか？
H列に実際に、入力をすれば　C列に自動で日付が入ります。
以下のように上部分を消去し、実行すると動作します。
この説明でわかりますか？どっちも単独では動作します。
よろしくお願いします。
Private Sub Worksheet_Change(ByVal Target As Range)

  Dim セル代入 As Range

  If Intersect(Target, Range("H20:H500")) Is Nothing Then
    Exit Sub
  End If
  Application.EnableEvents = False
  For Each セル代入 In Target
    If IsEmpty(セル代入.Value) Then
      セル代入.Offset(, -5).ClearContents
    Else
      If セル代入.Offset(, -5).Value = "" Then
        If Day(Date) >= 8 Then
          セル代入.Offset(, -5).Value = Format(DateSerial(Year(Date), Month(Date) + 1, 5), "gee.mm.dd")
        Else
          セル代入.Offset(, -5).Value = Format(DateSerial(Year(Date), Month(Date), 5), "gee.mm.dd")
        End If
      End If
    End If
      Next
  Application.EnableEvents = True
End Sub

以下も単独なら動きます。

 Private Sub Worksheet_Change(ByVal Target As Range)
     With Target
        If .Count > 1 Then Exit Sub
        If .Value = "" Then Exit Sub
        If Intersect(Target, Range("C20:C500")) Is Nothing Then Exit Sub

        If .Value < Range("C20").Value Then
            MsgBox "日付が起算日（C20セル）以前です？確認してください。" _
            & vbCrLf & vbCrLf & "C20セル以前は集計対象外になるため入力不可です。"
        Application.EnableEvents = False
        .Value = ""
        Application.EnableEvents = True
        End If
    End With
 End Sub

（satosi） 2017/04/10(月) 16:40

 ’こんな風につなげてみたらどうですか？

 Private Sub Worksheet_Change(ByVal Target As Range)
   Dim セル代入 As Range

      With Target
         If .Count > 1 Then Exit Sub
         If .Value = "" Then Exit Sub
     End With

     If Intersect(Target, Range("C20:C500"), Range("H20:H500")) Is Nothing Then Exit Sub

     If Not Intersect(Target, Range("C20:C500")) Is Nothing Then
         With Target
             If .Value < Range("C20").Value Then
                 MsgBox "日付が起算日（C20セル）以前です？確認してください。" _
                 & vbCrLf & vbCrLf & "C28セル以前は集計対象外になるため入力不可です。"
             Application.EnableEvents = False
             .Value = ""
             Application.EnableEvents = True
             End If
         End With

     Else
         Application.EnableEvents = False

         For Each セル代入 In Target
             If IsEmpty(セル代入.Value) Then
               セル代入.Offset(, -5).ClearContents
             Else
               If セル代入.Offset(, -5).Value = "" Then
                 If Day(Date) >= 8 Then
                   セル代入.Offset(, -5).Value = Format(DateSerial(Year(Date), Month(Date) + 1, 5), "gee.mm.dd")
                 Else
                   セル代入.Offset(, -5).Value = Format(DateSerial(Year(Date), Month(Date), 5), "gee.mm.dd")
                 End If
               End If
             End If
         Next

         Application.EnableEvents = True
      End If
 End Sub

（半平太） 2017/04/10(月) 16:42

（半平太）さん
ありがとうございます。
＞ Else以下
動作してくれませんでした。？
2017/04/10(月) 16:40コメントです
単独なら動くのですが・・・

（satosi） 2017/04/10(月) 16:51

＞ With Target
＞ If .Count > 1 Then Exit Sub
＞ If .Value = "" Then Exit Sub
＞ If Intersect(Target, Range("C20:C500")) Is Nothing Then Exit Sub
＞ If .Value < Range("C20").Value Then
＞ MsgBox "日付が起算日（C20セル）以前です？確認してください。" _
＞ & vbCrLf & vbCrLf & "C20セル以前は集計対象外になるため入力不可です。"
＞ Application.EnableEvents = False
＞ .Value = ""
＞ Application.EnableEvents = True
＞ End If
＞ End With

↑このコード、セルにロックかけて触れなくしたら要らなくないですか？

もっとちゃんと作業の手順をコードにして書かないとだめかも？
まずは日本語でちゃんと説明してみましょう。
VBA語に翻訳は皆さんが手伝ってくれると思うので。

（まっつわん） 2017/04/10(月) 17:00

（まっつわん）さん
ありがとうございます。
＞もっとちゃんと作業の手順をコードにして書かないとだめかも？
すみません。つなぎだけだったので皆さんならお解り頂けるかなと
思ってしまいました　帳票は以下です

        C        D        E       F          G         H
      日付      ｺｰﾄﾞ                                   金額   
20    H29.4.5    12                                    12000
21               15                                     2000←ここへ入力時C列へ日付
D列にｺｰﾄﾞ
E列：ｺｰﾄﾞから会社名呼びだし自動挿入
F.Gも同様です
H列に数値（金額）を入力した時点でC列に日付を代入するマクロです。
また最初のプロシージャはC列途中に修正等で日付を変更する場合があり
C20より以前の日付を入れた場合注意をうながすマクロです。
以上簡単ですが動作説明です。
（まっつわん） さん解りますか？
（satosi） 2017/04/10(月) 17:17

＞（まっつわん）さん解りますか？

なるほど、了解です。
でも、メッセージボックスで注意を促したところで、
何となくOK押したらそれっきりですよね？

条件付き書式設定で、セルの塗りつぶしの色を変える方が個人的には好きです。

（まっつわん） 2017/04/10(月) 22:42

 ごめんなさい。　簡単な事と思って、動作確認しないでアップしちゃいました。

 上案の以下のステートメントを変更してください。

 ＞ If Intersect(Target, Range("C20:C500"), Range("H20:H500")) Is Nothing Then Exit Sub

 　　↓　へ変更

  　If Intersect(Target, Range("C20:C500,H20:H500")) Is Nothing Then Exit Sub

（半平太） 2017/04/10(月) 23:09

（まっつわん）さん
＞何となくOK押したらそれっきりですよね？

入力されてOK押してもクリアしますので問題ないかと・・・

（半平太）さん
えっ　くくらないと駄目なんですか
ずっ～と色々解らないながら悩んでいたのに一瞬で解決しました。
ありがとうございました。

（satosi） 2017/04/11(火) 00:02

なるほど、、、、

条件を追加するならElseIfで追加したらいいと思います。

 Private Sub Worksheet_Change(ByVal Target As Range)
    Dim セル代入 As Range
    Dim c As Range
    Dim m As Long
    Dim v As Variant

    If Target.CountLarge > 1 Then Exit Sub

    If Intersect(Target, Range("C20:C500")) Is Nothing Then
        If Target.Value < Range("C20").Value Then
            MsgBox "日付が起算日（C20セル）以前です？確認してください。" _
                   & vbCrLf & vbCrLf & "C28セル以前は集計対象外になるため入力不可です。"
            Application.EnableEvents = False
            Application.Undo
            Application.EnableEvents = True
        End If

        '＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
    ElseIf Intersect(Target, Range("H20:H500")) Is Nothing Then
        Application.EnableEvents = False
        For Each セル代入 In Intersect(Target, Range("H20:H500")).Cells
            Set c = セル代入.Offset(, -5)
            If IsEmpty(セル代入.Value) Then
                v = Empty
            Else
                If IsEmpty(c.Value) Then
                    If Day(Date) >= 8 Then
                        m = Month(Date) + 1
                    Else
                        m = Month(Date)
                    End If
                    v = Format(DateSerial(Year(Date), m, 5), "gee.mm.dd")
                End If
            End If
            c.Value = v
        Next
    End If
    Application.EnableEvents = True
End Sub
（まっつわん） 2017/04/11(火) 09:05

（まっつわん）さん
ありがとうございます。
＞条件を追加するならElseIfで追加したらいいと思います。
了解いたしました。試してみます。

尚、作成いただきましたマクロですが
D.F.Hどこに入力してもWorksheet_Changeチェンジイベントが発生してしまいます。
また日付も挿入出来ませんでした。
自分なりに変更はしてみたのですが変化ありません。？

（satosi） 2017/04/11(火) 12:52

 >If Intersect(Target, Range("C20:C500")) Is Nothing Then
 と
 >ElseIf Intersect(Target, Range("H20:H500")) Is Nothing Then
 の部分は半平太さんのVBAにあるように
 >If Not Intersect(Target, Range("C20:C500")) Is Nothing Then

 >ElseIf Not Intersect(Target, Range("H20:H500")) Is Nothing Then
 ではないのか？

（ねむねむ） 2017/04/11(火) 13:08

（ねむねむ）さん
ありがとうございます。
一応入力は出来ましたが。今度は

            Application.EnableEvents = False
            Application.Undo★
            Application.EnableEvents = True
無理矢理以前の日付を入力するとUndoメゾットは失敗しました。とでて
Excelが動作しなくなります、また同様に日付（C列）をdeleteしても出来なくなります。？
マクロは難しいですぅ。
（satosi） 2017/04/11(火) 13:20

 >Excelが動作しなくなります
 これだけ。
 >Application.EnableEvents = False
 はこれ以降EnableEventsにTrueが設定されるかExcel本体が終了するまでイベントの発生を抑制する。

 なのでイミディエイトウィンドウで
 Application.EnableEvents = True
 と入力してEnterを押すかいったんExcelを終了させてみてくれ。
（ねむねむ） 2017/04/11(火) 13:26

（ねむねむ）さん
できました　Falseでしたね。
ありがとうございました。
（satosi） 2017/04/11(火) 15:11

コメント返信：

[ 一覧(最新更新順) ]

[[20170410161206]] 『Worksheet_Change連結について』（satosi） ページの最後に飛ぶ

[[20170410161206]]　『Worksheet_Change連結について』（satosi）　ページの最後に飛ぶ