У меня есть два кода, один из которых находится в модуле, а другой в листе1. Код в Sheet1 - это код Worksheet_Change. Всякий раз, когда я пытаюсь запустить код в модуле, он выдает ошибку и активирует код sheet1.
Я прошел по форуму и попробовал решения по определению целевых ячеек для Private Sub и использованию решений EnableEvents = False. Ничего из этого не работает. Код в листе 1 также не работает и выполняет все коды вместе.
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 (), 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, когда пытается вставить имя в ячейку. Есть ли способ заставить эту работу? Или любое предложение, которое поможет в этом?
Спасибо за ваши усилия заранее.