简体   繁体   English

当单元格结果按公式更改时运行宏

[英]Run Macro when cell result changes by formula

What I am needing: A macro to be triggered, let's call the macro "MacroRuns", whenever cell C3 returns a different value than it currently has, based on its FORMULA, NOT based on manually typing a different value.我需要什么:要触发的宏,让我们将宏称为“MacroRuns”,每当单元格 C3 返回与当前不同的值时,基于其公式,而不是基于手动键入不同的值。

I have spent all day reading through and attempting every "solution" on the first two pages of my google search on this topic.我花了一整天的时间阅读并尝试在我的谷歌搜索的前两页上关于这个主题的每个“解决方案”。 So far, nothing seems to work for me.到目前为止,似乎没有什么对我有用。 Please help!!!请帮忙!!! I would very much appreciate it!我将非常感激!

Example:例子:

I have now tried this but it corrupts my file after it works a few times.我现在已经尝试过这个,但它在运行几次后损坏了我的文件。

Private Sub Worksheet_Calculate()
    If Range("E3") <> Range("C3").Value Then
        Range("E3") = Range("B3").Value
        MsgBox "Successful"
    End If
End Sub

Module1, Sheet1 (Calculate), ThisWorkbook (Open) Module1、Sheet1(计算)、ThisWorkbook(打开)

Highlights强调

  • When the workbook opens, the value from C3 is read into the public variable TargetValue via TargetStart .当工作簿打开时,来自C3的值通过TargetStart读入公共变量TargetValue
  • When the value in C3 is being calculated, TargetCalc is activated via the calculate event.If the current value in C3 is different than TargetValue , MacroRuns is triggered and TargetValue is updated with the value in C3 .当值C3被计算出, TargetCalc经由计算event.If在当前值激活C3比不同TargetValueMacroRuns被触发并且TargetValue与在值更新C3

The Code编码

Module1模块1

Option Explicit

Public TargetValue As Variant
Private Const cTarget As String = "C3"

Sub TargetCalc(ws as Worksheet)
    If ws.Range(cTarget) <> TargetValue Then
        MacroRuns
        TargetValue = ws.Range(cTarget).Value
    End If
End Sub

Sub TargetStart()
    TargetValue = Sheet1.Range(cTarget).Value
End Sub

Sub MacroRuns()
    MsgBox "MacroRuns"
End Sub

ThisWorkbook这本工作簿

Option Explicit

Private Sub Workbook_Open()
    TargetStart
End Sub

Sheet1表 1

Option Explicit

Private Sub Worksheet_Calculate()
    TargetCalc Me
End Sub

If i understood your question you can try this code:如果我理解你的问题,你可以试试这个代码:

1)Right-click the Sheet tab and then click View Code 1)右键单击工作表选项卡,然后单击查看代码

  1. copy this code:复制此代码:

    Private Sub Worksheet_Change(ByVal Target As Range) Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Value1 As Variant Static Value2 As Variant Dim Value1 作为 Variant 静态 Value2 作为 Variant

    Value1 = Range("C3").value Value1 = Range("C3").value

    If Value1 <> Value2 Then MsgBox "Cell has changed." If Value1 <> Value2 Then MsgBox "Cell has changed." End If万一

    Value2 = Range("C3").value Value2 = Range("C3").value

    End Sub结束子

i tried this one:我试过这个:

in cell C3 i have wrote =SUM(A1:B1) when i try to change value in this cells also C3 change and i get the msgBox在单元格 C3 中,我写了 =SUM(A1:B1) 当我尝试更改此单元格中的值时,C3 也会更改,并且我得到了 msgBox

Hope this helps希望这可以帮助

EDIT the code to answer @ MD Ismail Hosen编辑代码以回答@ MD Ismail Hosen

if i understood your problem you can try this example code:如果我理解你的问题,你可以试试这个示例代码:

Private Sub Worksheet_Change(ByVal Target As Range)

'in this code i have used two range on the same row, but you can change as 
'you want. 
'In my case, the range that i check is Range("A1:C1") and the RANGE that i 'save old value is 
'RANGE("F1:H1") F1 is the sixth column.

Dim counter As Byte
Dim sizeRange As Byte

sizeRange = 3 ' my size range

For counter = 1 To sizeRange
    'on the left i check Range("A1:C1").On the right i check The Range("F1:H1")
    If Cells(1, counter) <> Cells(1, counter + 5) Then 'counter start from 1 
        MsgBox "Range Changed"
        Range("A1:C1").Copy Destination:=Range("F1:H1") ' use other code to copy the range
        Exit For
    End If
Next counter
End Sub

If you have a formula in your range ("A1:C1") you have to use this code to copy the new range value A1:C1 in F1:H1 else you get the error(loop the macro).如果您的范围内有公式(“A1:C1”),则必须使用此代码复制 F1:H1 中的新范围值 A1:C1,否则会出现错误(循环宏)。 'TO use this code if you have formula in the cells. '如果单元格中有公式,请使用此代码。

 Range("A1:C1").Select
        Selection.Copy
        Range("F1").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Hope this helps.希望这可以帮助。

Right.对。 I have a nugget to add in here, something that completely frustrated me upon trying Ferdinando's code (which by itself is very neat, thank you, Ferdinando!!)我要在这里添加一个金块,在尝试 Ferdinando 的代码时让我感到非常沮丧(它本身非常简洁,谢谢你,Ferdinando !!)

The main point is - if you are going to be using anything beyond just a messagebox (MsgBox "Cell has changed.") you need to add the following lines above AND below this line(otherwise the Excel will simply crash constantly due to endlessly trying to do the same).重点是 - 如果您要使用的不仅仅是消息框(MsgBox“Cell has changed.”),您需要在该行的上方和下方添加以下几行(否则 Excel 会因为无休止地尝试而不断崩溃)做同样的事情)。 Don't ask me why this is, but I finally-finally solved my problem with this.不要问我这是为什么,但我终于 - 最终解决了我的问题。 So here are the lines:所以这里是几行:

If Value1 <> Value2 Then
(ADD THIS:)     Application.EnableEvents = False
                MsgBox "Cell has changed."
(I call a macro running a query from MySQL instead of MsgBox)
(AND ADD THIS:) Application.EnableEvents = True

Hope this helps anyone in the situation I was in!!希望这可以帮助处于我所处情况的任何人!!

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM