简体   繁体   English

当单元格在特定范围内变化时运行宏vba

[英]Running Macro when cell changes in specific range vba

I created this yesterday and it was working fine but today it is no longer working. 我昨天创建了这个文件,它工作正常,但今天不再工作。 The goal is to have a drop down menu that allows for Y and N . 目的是要有一个允许YN的下拉菜单。 If the operator picks Y (we'll say in cell Y11), then because the cells beneath it contain the formula =IF($Y$11="Y","Y","") then it will turn to Y and every cell beneath it will do the same (Chain reaction). 如果运算符选择Y (我们将在单元格Y11中说),则由于其下面的单元格包含公式=IF($Y$11="Y","Y","")则它将变为Y并且每个它下面的细胞会做同样的事情(连锁反应)。

If the operator decides they were wrong to put Y there, then they can go back, click N , and it will replace that cell with the original formula. 如果操作员认为将Y放在此处是错误的,则可以返回并单击N ,它将用原始公式替换该单元格。

As I said, this was working yesterday but now is not. 就像我说的那样,这在昨天有效,但现在无效。 Does anyone see any weak points in the code? 有人在代码中看到任何弱点吗? This is being pasted into the sheet rather than a module. 这被粘贴到工作表而不是模块中。

Private Sub Reverse_NewBatch_Mistake(ByVal Target As Range)
    If Not Application.Intersect(Target, Range("Y12:Y36")) Is Nothing Then
        If ActiveCell = "Y" Then
            'do nothing
        End If

        If ActiveCell = "N" Then
            variable = ActiveCell.Offset(-1, 0).Address
            ActiveCell.Formula = "=if(" & variable & "=""Y"",""Y"","""")"
        End If
    End If
End Sub

You can achieve your desired result by using the Worksheet_Change event as below. 您可以通过使用如下的Worksheet_Change事件来获得所需的结果。

Simply place the code below under the worksheet you want to work with, the code also removes the need for all the cells to have formulas in them: 只需将下面的代码放在要使用的工作表下,该代码还消除了所有单元格中都包含公式的需要:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range: Set rng = Range("Y12:Y36")
'declare and set the range you wish to react as a chain reaction
    If Target.Address = "$Y$11" Then 'if cell Y11 has changed value
        If Target.Value = "Y" Then 'if the value is "Y" then
            rng = "Y" 'set the whole range as "Y"
        Else
            rng = "" 'else empty the range
        End If
    End If
End Sub

UPDATE: 更新:

Following from the comments, the code below will auto fill the range below the cell where the "Y" was entered until the last row on the rng: 在注释之后,下面的代码将自动填充输入“ Y”的单元格下方的范围,直到rng的最后一行:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
'disable events so the work we do below doesn't set the Change event again
    Dim ws As Worksheet: Set ws = Sheets("Sheet1")
    Dim rng As Range: Set rng = ws.Range("Y12:Y36")
    'declare and set the range you wish to react as a chain reaction
    Dim i As Long
    If Not Application.Intersect(Target, rng) Is Nothing Then
        For i = (Target.Row + 1) To (rng.Rows.Count + rng.Row - 1)
        'loop through from where the value was entered to the last row specified in rng
            If Target.Value = "Y" Then 'if value is "Y" then
                ws.Cells(i, "Y").Value = "Y" 'enter "Y" in the range below
            Else
                ws.Cells(i, "Y").Value = "" 'else empty cells below
            End If
        Next i
    End If
Application.EnableEvents = True
End Sub

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

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