不同范围的私人子工作表事件

Question

I know that you can have only one private sub worksheet change event however I am struggling to combine code for the events I need. I am new to VBA so any assistance or recommendations are appreciated. Would it be more efficient to use select case?

First code needed:

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

Second code needed:

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 will certainly tidy up your code. You might also want to build in a check that Target is not more than a single cell.

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