異なる範囲のプライベートサブワークシートイベント

Question

プライベートサブワークシートの変更イベントは1つしかできませんが、私は必要なイベントのコードを組み合わせるのに苦労しています。私はVBAに新しいので、どんな援助や勧告も感謝しています。 select caseを使う方が効率的でしょうか？

まずコード必要：

Private Sub Worksheet_Change(ByVal target As Range) 

Dim cell As Range 
Set cell = Range("AK9:AR50") 

Application.EnableEvents = False 
If Not Application.Intersect(cell, target) Is Nothing Then 
If target.Column = 37 Then 
    target.Offset(, 1).Value = target.Value/Range("V" & target.Row).Value 
ElseIf target.Column = 38 Then 
    target.Offset(, -1).Value = WorksheetFunction.RoundUp((target.Value * Range("V" & target.Row).Value), -2) 
End If 
If target.Column = 39 Then 
    target.Offset(, 1).Value = target.Value/Range("V" & target.Row).Value 
ElseIf target.Column = 40 Then 
    target.Offset(, -1).Value = WorksheetFunction.RoundUp((target.Value * Range("V" & target.Row).Value), -2) 
End If 
If target.Column = 41 Then 
    target.Offset(, 1).Value = WorksheetFunction.RoundUp((target.Value * Range("V" & target.Row).Value), -2) 
ElseIf target.Column = 42 Then 
    target.Offset(, -1).Value = target.Value/Range("V" & target.Row).Value 
End If 
If target.Column = 43 Then 
    target.Offset(, 1).Value = target.Value/Range("V" & target.Row).Value 
ElseIf target.Column = 44 Then 
    target.Offset(, -1).Value = WorksheetFunction.RoundUp((target.Value * Range("V" & target.Row).Value), -2) 
End If 
End If 
Application.EnableEvents = True 

End Sub 

必要セカンドコード：

Private Sub Worksheet_Change(ByVal Target As Range) 
Dim controlRng, nRng As Range 
Set controlRng = Range("AF9:AF1000") 
Set nRng = Intersect(controlRng, Target) 

If nRng Is Nothing Then Exit Sub 

If Target.Value = "No Promotion" Then 
    Target.Offset(0, 1) = Range("M" & Target.Row).Value 
ElseIf Target.Value = "Promotion" Then 
    Target.Offset(0, 1) = "" 
ElseIf Target.Value = "Demotion" Then 
    Target.Offset(0, 1) = "" 
ElseIf Target.Value = "Partner" Then 
    Target.Offset(0, 1) = "" 
ElseIf Target.Value = "" Then 
    Target.Offset(0, 1) = "" 
End If 
End Sub 

Answer 1

のSelect Caseは、あなたのコードまで確かに整頓ます。また、Targetが単一のセルを超えていないことを確認することもできます。

Private Sub Worksheet_Change(ByVal Target As Range) 

Dim cell As Range 
Dim controlRng As Range, nRng As Range 

Set cell = Range("AK9:AR50") 
Set controlRng = Range("AF9:AF1000") 
Set nRng = Intersect(controlRng, Target) 

Application.EnableEvents = False 

If Not Application.Intersect(cell, Target) Is Nothing Then 
    Select Case Target.Column 
     Case 37, 39, 41, 43 
      Target.Offset(, 1).Value = Target.Value/Range("V" & Target.Row).Value 
     Case 38, 40, 42, 44 
      Target.Offset(, -1).Value = WorksheetFunction.RoundUp((Target.Value * Range("V" & Target.Row).Value), -2) 
    End Select 
End If 

If Not nRng Is Nothing Then 
    Select Case Target.Value 
     Case "No Promotion" 
      Target.Offset(0, 1) = Range("M" & Target.Row).Value 
     Case "Promotion", "Demotion", "Partner", "" 
      Target.Offset(0, 1).ClearContents 
    End Select 
End If 

Application.EnableEvents = True 

End Sub