我有两个代码,一个在模块中,另一个在sheet1中。Sheet1中的代码是Worksheet_Change代码。每当我试图在模块中运行代码时,它都会给出一个错误并激活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时,代码都会运行并粘贴内容,但同时也会将其清除。ALso当我运行模块时,它会执行代码,但是当它试图将名称粘贴到单元格中时,它会触发Private Sub。有没有什么方法可以做到这一点呢?或任何对此有帮助的建议?提前感谢您的努力。
发布于 2019-01-04 03:43:05
你不能设置一个公共变量,比如modRun或其他值为1,然后在工作表中,在sub开始的时候,它检查这个变量,看看它是否为1,然后退出sub?只需确保在模块结束时将变量设置回零即可。
发布于 2019-01-05 05:43:28
好了,我找到了一个简单但不短的问题解决方案。我只是将每个目标单元格定义为不同的变量。它可以工作,因为它没有触发其余的代码。这并不是一个很好的解决方案,但却达到了我想要的目的。我正在张贴整个代码,如果有人可以帮助我减少行数或知道一个更好的方法,这将是非常感谢。感谢您的回复和建议。
'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
有更多的代码行,并且所有的范围都被命名。谢谢。
https://stackoverflow.com/questions/54025778
复制相似问题