カーソルがExcelの下のセルにジャンプしません

Question

私は本当に新しいコーディングで、今は少し問題があります。 Excelシートの変更を追跡できるコードを作成しました。コードは正常に動作していますが、セルに書いてEnterキーを押すと、カーソルが同じセルに戻ります。私は答えを見つけることができないと私はExcelで高度なオプションを試してみました。

'Tracker 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) 
If ActiveSheet.Name = "Changes" Then Exit Sub 
Application.EnableEvents = False 
UserName = Environ("USERNAME") 
NewVal = Target.Value 
Application.Undo 
oldVal = Target.Value 
lr = Sheets("Changes").Range("A" & Rows.Count).End(xlUp).Row + 1 
Sheets("Changes").Range("A" & lr) = Now 
Sheets("Changes").Range("B" & lr) = ActiveSheet.Name 
Sheets("Changes").Range("C" & lr) = Target.Address 
Sheets("Changes").Range("D" & lr) = oldVal 
Sheets("Changes").Range("E" & lr) = NewVal 
Sheets("Changes").Range("F" & lr) = UserName 
Target = NewVal 
Application.EnableEvents = True 

ありがとう！

Answer 1

元に戻す前にユーザーの選択をグラデーションし、後で再選択する必要があります。

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) 
    Dim sel As Range, UserName, NewVal, oldVal, lr As Long 

    If ActiveSheet.Name = "Changes" Then Exit Sub 

    'check there's a range to remember 
    If TypeName(Selection) = "Range" Then Set sel = Selection 

    Application.EnableEvents = False 
    UserName = Environ("USERNAME") 
    NewVal = Target.Value 
    Application.Undo 
    oldVal = Target.Value 

    With Sheets("Changes") 
     lr = .Range("A" & Rows.Count).End(xlUp).Row + 1 
     .Range("A" & lr) = Now 
     .Range("B" & lr) = ActiveSheet.Name 
     .Range("C" & lr) = Target.Address 
     .Range("D" & lr) = oldVal 
     .Range("E" & lr) = NewVal 
     .Range("F" & lr) = UserName 
    End With 
    Target = NewVal 

    Application.EnableEvents = True 

    're-select any previous selection 
    If Not sel Is Nothing Then sel.Select 

End Sub 

注：Target> 1個の細胞、または全列/行であってもよいです。これらのケースでは.Valueは配列であり、単一の値ではないため、コードがクラッシュします。これを処理することで、コードが堅牢になります。もう少し複雑です。