excel - Worksheet_Change 函数即使对于非目标单元格也会运行，是否可以防止

问题描述

我有两个代码，一个在模块中，另一个在 sheet1 中。Sheet1 中的代码是 Worksheet_Change 代码。每当我尝试在 Module 中运行代码时，它都会出错并激活 sheet1 代码。

我浏览了论坛并尝试了为解决方案指定目标单元格Private Sub和使用EnableEvents = False解决方案的解决方案。这些都不起作用。sheet1 中的代码也无法同时执行所有代码。

Private Sub Worksheet_Change(ByVal Target As range)

Dim KeyCell As range

Set KeyCell = range("A1:J1")    

If Not Application.Intersect(KeyCell, Me.range(A1)) Is Nothing Then
    OffEmp range("B151:B210"), False

    If range("A1") = "A Off" Then
        OffEmp range("B151:B210"), True
    ElseIf range("A1") = "A" Then
            range("B151:B210").ClearContents
    End If
End If
'After executing the above code it jumps to this code and executes it even when Cell B1 is not changed.

If Not Application.Intersect(KeyCell, Target) Is Nothing Then
    OffEmp range("B151:B210"), False
    If range("B1") = "B Off" Then
        OffEmp range("B2:B9"), True
    ElseIf range("B1") = "B" Then
            range("B151:B210").ClearContents
    End If
End If

每当我尝试更改 A1 中的任何内容时，代码都会运行并粘贴内容并同时清除它。Off range(), False/True 是一个不同的 Sub 如下：

Sub Off(R As range, Off As Boolean)
    With R.Select
             Selection.Copy
         If Off Then
            If IsEmpty(range("$B$151")) = True Then
                    range("$B$151").Select
                Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
            ElseIf IsEmpty(range("$B$151")) = False Then
                    range("$B$151").Activate
                    ActiveCell.End(xlDown).Offset(1, 0).Select
                    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
                    SkipBlanks:=False, Transpose:=False
            End If
        End If
    End With
End Sub

我试图作为模块运行的代码是：

Option Explicit
'use a constant to store the highlight color...
Const HIGHLIGHT_COLOR = 9894500 'RGB(100, 250, 150)'Is a cell highlighted? 
EDIT: changed the function name to IsHighlighted

Sub AssignBided()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim cel1 As range
Dim cel2 As range
Dim Bid As range
Dim line As range
Dim Offemp As range
Dim BidL8 As range
Dim BidL8E As range
Dim coresVal As String

Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
Set Bid = ws2.range("$D$12:$D$40, $D$43:$D$58, $D$61:$D$77, $D$81:$D$97, $D$101:$D$117")
Set line = ws2.range("$B$12:$B$40, $B$43:$B$58, $B$61:$B$77, $B$81:$B$97, $B$101:$B$117")
Set Offemp = ws2.range("$B$151:$B$210")
Set BidL8 = ws1.range("$R$27:$R$263")
Set BidL8E = ws1.range("$S$27:$S$263")

For Each cel2 In line
    If IsHighlighted(cel2) Then
        For Each cel1 In BidL8E
            If Application.WorksheetFunction.CountIf(Offemp, cel1.Value) > 0 Then
            Else: cel2.Offset(0, 2).Activate
                    ActiveCell.FormulaR1C1 = "=INDEX(Sheet1!$S$27:$S$263,MATCH(" & cel2.Value & ",Sheet1!$R$27:$R$263,0))"
            End If
        Next cel1
    End If
Next cel2
End Sub
Function IsHighlighted(c As range)
    IsHighlighted = (c.Interior.Color = HIGHLIGHT_COLOR)
End Function

我很抱歉这个冗长的问题。但我在这里解决了问题。每当我更改单元格 A1 时，代码都会运行并按应有的方式粘贴内容，但同时也会将其清除。此外，当我运行模块时，它会执行代码，但在尝试将名称粘贴到单元格中时会触发 Private Sub。有什么方法可以使这项工作吗？或者有什么建议可以帮助解决这个问题？提前感谢您的努力。

标签： excelvba

excel - Worksheet_Change 函数即使对于非目标单元格也会运行，是否可以防止

问题描述

解决方案

推荐阅读