none
ある列に入力の都度上書き保存させるVBAコードを教えて下さい。 RRS feed

  • 質問

  • シートモジュールに以下のコードが入力されています。

    G列に入力の都度上書き保存させたいのですが、どこにどのようなコードを入れればいいか教えて下さい。

    宜しくお願い致します。

    Option Explicit
    Private Sub Worksheet_Change(ByVal Target As Range)
    '変更されたセル範囲に E5 セルが含まれない場合
    If Not Intersect(Target, Me.Range("E5")) Is Nothing Then
    'このプロシージャを抜ける
    Exit Sub
    End If
    'J14 セルの値と E5 セルの値が一致する場合
    If Me.Range("J14").Value = Me.Range("E5").Value Then
    'イベントの発生を無効にする
    '( Change イベントの連鎖を回避するため)
    Application.EnableEvents = False
    '現在のシステム日時を I14 セルに代入する
    Me.Range("I14").Value = Now
    'イベントの発生を有効にする
    Application.EnableEvents = True
    'このブックを上書き保存する
    ThisWorkbook.Save
    End If
    'J9 セルの値と E5 セルの値が一致する場合
    If Me.Range("J9").Value = Me.Range("E5").Value Then
    'イベントの発生を無効にする
    '( Change イベントの連鎖を回避するため)
    Application.EnableEvents = False
    '現在のシステム日時を I18 セルに代入する
    Me.Range("I18").Value = Now
    'イベントの発生を有効にする
    Application.EnableEvents = True
    'このブックを上書き保存する
    ThisWorkbook.Save
    End If
    End Sub

    2021年2月21日 2:08

回答

  • 提示されたコードでは、E5セル以外が変更された場合にJ14セルとE5セルの値が等しいときに上書き保存し、また、J19セルとE5セルの値が等しいときに上書き保存するようになっています。次のように下線を引いた2行を挿入して修正すると、G列が変更された場合、上書き保存するとともに、J14セルとE5セルの値が等しいと上書き保存し、また、J19セルとE5セルが等しいときに上書き保存します。

    Option Explicit
    Private Sub Worksheet_Change(ByVal Target As Range)
    '変更されたセル範囲に E5 セルが含まれない場合
    If Not Intersect(Target, Me.Range("E5")) Is Nothing Then
    'E5セルが変更された場合;このプロシージャを抜ける
    Exit Sub
    ElseIf Not Intersect(Target, Me.Columns("G")) Is Nothing Then
    ThisWorkbook.Save
    End If
    'J14 セルの値と E5 セルの値が一致する場合
    If Me.Range("J14").Value = Me.Range("E5").Value Then
    'イベントの発生を無効にする
    '( Change イベントの連鎖を回避するため)
    Application.EnableEvents = False
    '現在のシステム日時を I14 セルに代入する
    Me.Range("I14").Value = Now
    'イベントの発生を有効にする
    Application.EnableEvents = True
    'このブックを上書き保存する
    ThisWorkbook.Save
    End If
    'J9 セルの値と E5 セルの値が一致する場合
    If Me.Range("J9").Value = Me.Range("E5").Value Then
    'イベントの発生を無効にする
    '( Change イベントの連鎖を回避するため)
    Application.EnableEvents = False
    '現在のシステム日時を I18 セルに代入する
    Me.Range("I18").Value = Now
    'イベントの発生を有効にする
    Application.EnableEvents = True
    'このブックを上書き保存する
    ThisWorkbook.Save
    End If
    End Sub



    2021年2月21日 12:47