«Как применить код« Private Sub Worksheet_Change (ByVal Target As Range) »ко всем строкам на листе» - PullRequest
0 голосов
/ 13 июня 2019

"Я пытаюсь запустить Private Sub Worksheet_Change(ByVal Target As Range) для E7: E17 для достижения ниже (например)

If E7 = Yes then F7="Reject", G7=H7, I7=2*10, 
   E7 = No then F7="Pass", G7=H7*5, I7=2,
   .
   .
If E17 = = Yes the F17="Type", G7=H17, I17=2*10,
   E17 = No then F17="Pass", G17=H17*5, I17=2,

Я пытался как править отдельный код для каждой строки, код работает только для 7 строк после этогонаступает ошибка (процедура слишком длинная)

Worksheet_Change code: -

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("E7:E17")) Is Nothing Then
    Select Case Range("E7:E17")
      Case "NO": MacroNoE7
      Case "YES": MacroYesE7
    End Select
End If
End Sub

Пример кода VBA для выполнения в строках E7: E17: -

Sub MacroYesE7()

Sheets("Data").Range("E162").Copy
Sheets("Data").Range("L7").PasteSpecial xlPasteValidation
Application.CutCopyMode = False

Sheets("Data").Range("L7") = ""
Sheets("Data").Range("M7") = ""

End Sub

Sub MacroNoE7()

Range("L7").Select
With Selection.Validation
    .Delete
End With

Sheets("Data").Range("L7") = "NA"
Sheets("Data").Range("M7") = "NA"

End Sub

Сообщение об ошибке: - Слишком длинная процедура

1 Ответ

0 голосов
/ 13 июня 2019

Посмотрите, работает ли это.Передайте Target (измененную ячейку) каждой из подпрограмм.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("E7:E17")) Is Nothing Then
    Select Case Target.Value
      Case "NO": MacroNo (Target)
      Case "YES": MacroYes (Target)
    End Select
End If
End Sub

Sub MacroYes(r As Range)

Sheets("Data").Range("E162").Copy
Sheets("Data").Range("L" & r.Row).PasteSpecial xlPasteValidation
Application.CutCopyMode = False

Sheets("Data").Range("L" & r.Row).Resize(, 2).ClearContents

End Sub

Sub MacroNo(r As Range)

Range("L" & r.Row).Validation.Delete

Sheets("Data").Range("L" & r.Row).Resize(, 2).Value = "NA"

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...