我昨天创建了这个文件,它工作正常,但是今天它不再工作。目的是要有一个允许Y
和N
的下拉菜单。如果运算符选择Y
(我们将在单元格Y11中说),则由于其下面的单元格包含公式=IF($Y$11="Y","Y","")
,因此它将转向Y
,并且其下方的每个单元格都将相同(链反应)。
如果操作员认为将Y
放在此处是错误的,则可以返回,单击N
,它将用原始公式替换该单元格。
正如我所说,这昨天一直有效,但现在没有。有人在代码中看到任何弱点吗?这是粘贴到工作表中而不是模块中。
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
答案 0 :(得分:0)
您可以通过使用如下的Worksheet_Change事件来获得所需的结果。
只需将下面的代码放在要使用的工作表下,该代码还消除了所有单元格中都包含公式的需要:
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
更新:
在注释之后,下面的代码将自动填充输入“ 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