VBA和Excel我需要在單元格更改上運行宏

Question

    Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("E2:E50")) Is Nothing Then
    Call sbDriverCopy
    Call sbDriverRotation
    End If
    End Sub

    Sub sbDriverRotation()
    Dim strDataRange, strkeyRange As String
    strDataRange = "J1:N50"
    strkeyRange = "L2:L50"
    With Sheets("Sheet1").Sort
    .SortFields.Clear
    .SortFields.Add _
    Key:=Range(strkeyRange), _
    SortOn:=xlSortOnValues, _
    Order:=xlDescending, _
    DataOption:=xlSortNormal
    .SetRange Range(strDataRange)
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
    End With
    End Sub


    Sub sbDriverCopy()
    Range("D1:H50").Copy
    Range("J1").Select
    ActiveSheet.PasteSpecial xlPasteValuesAndNumberFormats
    Application.CutCopyMode = False
    End Sub

E列是在BA列或TO-A列上計算的，並且當這些計算的值進入E列時，要根據該更改進行計算，所以我要觸發我的marcos。 我嘗試了幾種不同的方法，但無法將marco開除。

比我認為我需要將marco合並為一個嗎？

    Private Sub Worksheet_Calculate()
    If Range("E2").Value <> PrevVal Then
    MsgBox "Value Changed"
    PrevVal = Range("E2").Value
    End If
    End Sub                                                                                                   

所以我可以在單元格（E2）的變化上觸發它，但無法弄清楚如何使其在一定范圍內工作（E2：E50）

Answer 1

    Private Sub Worksheet_Calculate()
    'Updateby Extendoffice
        Dim Xrg As Range
        Set Xrg = Range("E2:E50")
        If Not Intersect(Xrg, Range("E2:E50")) Is Nothing Then
            sbDriverCopy
            sbDriverRotation
        End If
        Set Xrg = Nothing
    End Sub

    Sub sbClearDriverRotation()
        Range("J1:N50").ClearContents
    End Sub

    Sub sbDriverCopy()
        Range("D1:H50").Copy
        Range("J1").Select
        ActiveSheet.PasteSpecial xlPasteValuesAndNumberFormats
        Application.CutCopyMode = False
    End Sub

    Sub sbDriverRotation()
        Dim strDataRange, strkeyRange As String
            strDataRange = "J1:N50"
            strkeyRange = "L2:L50"
            With Sheets("Sheet1").Sort
                .SortFields.Clear
                .SortFields.Add _
                    Key:=Range(strkeyRange), _
                    SortOn:=xlSortOnValues, _
                    Order:=xlDescending, _
                    DataOption:=xlSortNormal
                .SetRange Range(strDataRange)
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
    End Sub

Answer 2

這是一個很好的示例，說明當單元格值更改時如何發送電子郵件。

Sub Mail_small_Text_Outlook()
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Working in Excel 2000-2016
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    strbody = "Hi there" & vbNewLine & vbNewLine & _
              "Cell A1 is changed" & vbNewLine & _
              "This is line 2" & vbNewLine & _
              "This is line 3" & vbNewLine & _
              "This is line 4"

    On Error Resume Next
    With OutMail
        .To = "ron@debruin.nl"
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .Body = strbody
        'You can add a file like this
        '.Attachments.Add ("C:\test.txt")
        .Display   'or use .Send
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

https://www.rondebruin.nl/win/s1/outlook/bmail9.htm