VBA изменить событие нескольких целей

Question

во-первых, извиняюсь за длинный пост, я изо всех сил пытаюсь создать событие изменения на VBA, где комментарий создается в нескольких диапазонах.У меня есть код ниже для работы в одном диапазоне, но когда я пытаюсь расширить его до другого диапазона, либо происходит ошибка, либо он просто не читает код.любая помощь будет принята.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Author, EmployeeName, SiteName, ShiftTimes, PayRate As String
Dim DateEntered As Date
Dim intRow As Integer
Dim cmt As Comment
Dim lBreak As Long

If Intersect(Target, Range("C4:AG19")) Is Nothing Then Exit Sub
intRow = Target.Row
Author = Application.UserName
EmployeeName = Application.WorksheetFunction.Index(Range("$B$4:$B$19"), Target.Row)
SiteName = Range("B2").Value
ShiftTimes = Application.VLookup(Target.Value, Range("AI10:AJ13"), 2, False)
SitePayRate = format((Range("AJ7").Value), "£#,##0.00") & " p/h"
DateEntered = Now()

With Target
    .ClearComments
    .AddComment Author & Chr(10) _
    & EmployeeName & Chr(10) _
    & SiteName & Chr(10) _
    & ShiftTimes & Chr(10) _
    & PayRate & Chr(10) _
    & DateEntered
    .Comment.Shape.TextFrame.AutoSize = True
    .Comment.Visible = False
End With

Set cmt = Target.Comment
If cmt Is Nothing Then
    Exit Sub
End If

'find the line break which is Chr(10)
lBreak = InStr(1, cmt.Text, Chr(10))

'format username in red and bold
With cmt.Shape.TextFrame
    .Characters.Font.Bold = False
    .Characters(1, lBreak).Font.ColorIndex = 1
    .Characters(1, lBreak).Font.Bold = True
    .Characters(lBreak + 1, Len(cmt.Text)).Font.ColorIndex = 1
End With
End Sub

Я надеюсь достичь, когда целевой диапазон (C32: AG40) вызывает следующую информацию из таблицы данных

If Intersect(Target, Range("C32:AG40")) Is Nothing Then Exit Sub
intRow = Target.Row
Author = Application.UserName
EmployeeName = Application.WorksheetFunction.Index(Range("$B$32:$B$40"), Target.Row)
SiteName = Range("B30").Value
ShiftTimes = Application.VLookup(Target.Value, Range("AI38:AJ41"), 2, False)
SitePayRate = format((Range("AJ35").Value), "£#,##0.00") & " p/h"
DateEntered = Now()

Я надеюсь, что я объяснил себе ясно и еще раз, любая помощь приветствуется.

Answer 1

Попробуйте

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Author, EmployeeName, SiteName, ShiftTimes, PayRate As String
    Dim DateEntered As Date
    Dim intRow As Integer
    Dim cmt As Comment
    Dim lBreak As Long

    Dim rngIndex As Range, rngSitName As Range, rngTime As Range
    Dim rngRate As Range
    Dim Rng1 As Range, Rng2 As Range

    Set Rng1 = Range("C4:AG19")
    Set Rng2 = Range("C32:AG40")

    If Intersect(Target, Union(Rng1, Rng2)) Is Nothing Then Exit Sub

    If Not Intersect(Target, Rng1) Is Nothing Then
        Set rngIndex = Range("AI10:AJ13")
        Set rngSitName = Range("B2")
        Set rngTime = Range("AI10:AJ13")
        Set rngRate = Range("AJ7").Value
    ElseIf Not Intersect(Target, Rng2) Is Nothing Then
        Set rngIndex = Range("AI38:AJ41")
        Set rngSitName = Range("B30")
        Set rngTime = Range("AI10:AJ13")
        Set rngRate = Range("AJ35").Value
    End If

    intRow = Target.Row
    Author = Application.UserName
    EmployeeName = Application.WorksheetFunction.Index(rngIndex, Target.Row)
    SiteName = rngSitName
    ShiftTimes = Application.VLookup(Target.Value, rngTime, 2, False)
    SitePayRate = Format(rngRate, "￡#,##0.00") & " p/h"
    DateEntered = Now()

    With Target
        .ClearComments
        .AddComment Author & Chr(10) _
        & EmployeeName & Chr(10) _
        & SiteName & Chr(10) _
        & ShiftTimes & Chr(10) _
        & PayRate & Chr(10) _
        & DateEntered
        .Comment.Shape.TextFrame.AutoSize = True
        .Comment.Visible = False
    End With

    Set cmt = Target.Comment
    If cmt Is Nothing Then
        Exit Sub
    End If

    'find the line break which is Chr(10)
    lBreak = InStr(1, cmt.Text, Chr(10))

    'format username in red and bold
    With cmt.Shape.TextFrame
        .Characters.Font.Bold = False
        .Characters(1, lBreak).Font.ColorIndex = 1
        .Characters(1, lBreak).Font.Bold = True
        .Characters(lBreak + 1, Len(cmt.Text)).Font.ColorIndex = 1
    End With
End Sub

Answer 2

Я предлагаю вам избежать "если пересекаются ... тогда выходите из sub"

Private Sub Worksheet_Change(ByVal Target As Range)
    '...
    If Not (Intersect(Target, Range("C4:AG19")) Is Nothing) Then
        '...
        Debug.Print "Range C4:AG19"

    ElseIf Not (Intersect(Target, Range("C32:AG40")) Is Nothing) Then
        '...
        Debug.Print "Range C32:AG40"
    End If
End Sub