2017-10-30 11 views
0
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列私のマルコスを撃つ。私はいくつかの異なる方法を試しましたが、マルコに火をつけることはできません。VBAとExcelセルの変更でマクロを実行する必要があります

私は自分のマルコを1つにまとめる必要があると思っていますか?

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

だから私は、これは、細胞の変化(E2)に火災に取得することができますが、それは範囲(E2:E50)のために働くために取得する方法を見つけ出すカントここ

+5

'Worksheet_Change'式の計算から生じた変化によってトリガーされません - あなたは計算イベントを使用する必要があります。 –

答えて

0

はAですセル値が変更されたときに電子メールを送信する方法の素晴らしい例。

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 = "[email protected]" 
     .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

0
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 
関連する問題