[英]VBA and Excel I need to run a macro on cell change
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
The E column is calculated on either the BA column or TO-A column and on that change when the values of those calculations go to the E column I want to fire my marcos. E列是在BA列或TO-A列上计算的,并且当这些计算的值进入E列时,要根据该更改进行计算,所以我要触发我的marcos。 I tried several different ways but cant get the marco to fire. 我尝试了几种不同的方法,但无法将marco开除。
Than I am thinking i need to combine my marco into one? 比我认为我需要将marco合并为一个吗?
Private Sub Worksheet_Calculate()
If Range("E2").Value <> PrevVal Then
MsgBox "Value Changed"
PrevVal = Range("E2").Value
End If
End Sub
So I can get this to fire on a change in cell(E2) but cant figure out how to get it to work for a range(E2:E50) 所以我可以在单元格(E2)的变化上触发它,但无法弄清楚如何使其在一定范围内工作(E2:E50)
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
Here is a great example of how to send an email when a cell value changes. 这是一个很好的示例,说明当单元格值更改时如何发送电子邮件。
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 https://www.rondebruin.nl/win/s1/outlook/bmail9.htm
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.