文档建议反馈控制台
首页
学习
活动
专区
工具
TVP
最新优惠活动
文章/答案/技术大牛
发布
社区首页 >问答首页 >即使对于非目标像元，Worksheet_Change函数也会运行。是否可以防止它

问即使对于非目标像元，Worksheet_Change函数也会运行。是否可以防止它
EN

Stack Overflow用户
提问于 2019-01-03 23:59:35
回答 2查看 417关注 0票数 1

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

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

代码语言：javascript
复制
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，如下所示：

代码语言：javascript
复制
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

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

代码语言：javascript
复制
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时，代码都会运行并粘贴内容，但同时也会将其清除。ALso当我运行模块时，它会执行代码，但是当它试图将名称粘贴到单元格中时，它会触发Private Sub。有没有什么方法可以做到这一点呢？或任何对此有帮助的建议？提前感谢您的努力。

excel
vba
EN

回答 2

Stack Overflow用户

发布于 2019-01-04 03:43:05

你不能设置一个公共变量，比如modRun或其他值为1，然后在工作表中，在sub开始的时候，它检查这个变量，看看它是否为1，然后退出sub？只需确保在模块结束时将变量设置回零即可。

票数 1
EN

Stack Overflow用户

发布于 2019-01-05 05:43:28

好了，我找到了一个简单但不短的问题解决方案。我只是将每个目标单元格定义为不同的变量。它可以工作，因为它没有触发其余的代码。这并不是一个很好的解决方案，但却达到了我想要的目的。我正在张贴整个代码，如果有人可以帮助我减少行数或知道一个更好的方法，这将是非常感谢。感谢您的回复和建议。

代码语言：javascript
复制
'Remove Case Sensitivity
Option Compare Text
Private Sub Worksheet_Change(ByVal Target As range)

Dim KeyCell1 As range
Dim KeyCell2 As range
Dim KeyCell3 As range
Dim KeyCell4 As range
Dim KeyCell5 As range
Dim KeyCell6 As range
Dim KeyCell7 As range
Dim KeyCell8 As range
Dim KeyCell9 As range
Dim KeyCell10 As range
Dim KeyCell11 As range

Set KeyCell1 = range("A1")
Set KeyCell2 = range("B1")
Set KeyCell3 = range("C1")
Set KeyCell4 = range("D1")
Set KeyCell5 = range("E1")
Set KeyCell6 = range("F1")
Set KeyCell7 = range("G1")
Set KeyCell8 = range("H1")
Set KeyCell9 = range("I1")
Set KeyCell10 = range("J1")
Set KeyCell11 = range("Line8_P_Mon, Line10_P_Mon, Line11_P_Mon, Line12_P_Mon")

If Not Application.Intersect(KeyCell1, Target) Is Nothing Then
    OffEmp range("Off_Mon"), False

    If range("A1") = "A Off" Then
        OffEmp range("A2:A9"), True
    ElseIf range("A1") = "A" Then
            range("Off_Mon").ClearContents
    End If
End If

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

If Not Application.Intersect(KeyCell3, Target) Is Nothing Then
    OffEmp range("Off_Mon"), False
    If InStr(1, range("C1"), "C Off") > 0 Then
        OffEmp range("C2:C9"), True
    ElseIf range("C1") = "C" Then
            range("Off_Mon").ClearContents
    End If
End If

If Not Application.Intersect(KeyCell4, Target) Is Nothing Then
    OffEmp range("Off_Mon"), False
    If InStr(1, range("D1"), "D Off") > 0 Then
        OffEmp range("D2:D9"), True
    ElseIf range("D1") = "D" Then
            range("Off_Mon").ClearContents
    End If
End If

If Not Application.Intersect(KeyCell5, Target) Is Nothing Then
    OffEmp range("Off_Mon"), False
    If InStr(1, range("E1"), "E Off") > 0 Then
        OffEmp range("E2:E9"), True
    ElseIf range("E1") = "E" Then
            range("Off_Mon").ClearContents
    End If
End If

If Not Application.Intersect(KeyCell6, Target) Is Nothing Then
    OffEmp range("Off_Mon"), False
    If InStr(1, range("F1"), "F Off") > 0 Then
        OffEmp range("F2:F9"), True
    ElseIf range("F1") = "F" Then
            range("Off_Mon").ClearContents
    End If
End If

If Not Application.Intersect(KeyCell7, Target) Is Nothing Then
    OffEmp range("Off_Mon"), False

    If InStr(1, range("G1"), "G Off") > 0 Then
        OffEmp range("G2:G9"), True
    ElseIf range("G1") = "G" Then
            range("Off_Mon").ClearContents
    End If
End If

If Not Application.Intersect(KeyCell8, Target) Is Nothing Then
    OffEmp range("Off_Mon"), False
    If InStr(1, range("H1"), "H Off") > 0 Then
        OffEmp range("H2:H9"), True
    ElseIf range("H1") = "H" Then
            range("Off_Mon").ClearContents
    End If
End If

If Not Application.Intersect(KeyCell9, Target) Is Nothing Then
    OffEmp range("Off_Mon"), False
    If InStr(1, range("I1"), "I Off") > 0 Then
        OffEmp range("I2:I9"), True
    ElseIf range("I1") = "I" Then
            range("Off_Mon").ClearContents
    End If
End If

If Not Application.Intersect(KeyCell10, Target) Is Nothing Then
    OffEmp range("Off_Mon"), False
    If InStr(1, range("J1"), "J Off") > 0 Then
        OffEmp range("J2:J9"), True
    ElseIf range("J1") = "J" Then
            range("Off_Mon").ClearContents
    End If
End If

有更多的代码行，并且所有的范围都被命名。谢谢。

票数 0
EN
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：

https://stackoverflow.com/questions/54025778

复制
相关文章

相似问题

领券

腾讯云开发者

扫码关注腾讯云开发者

扫码关注腾讯云开发者

领取腾讯云代金券

热门产品

热门推荐

更多推荐

Copyright © 2013 - 2024 Tencent Cloud. All Rights Reserved. 腾讯云 版权所有 

深圳市腾讯计算机系统有限公司 ICP备案/许可证号：粤B2-20090059 深公网安备号 44030502008569

腾讯云计算（北京）有限责任公司 京ICP证150476号 |  京ICP备11018762号 | 京公网安备号11010802020287

问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档