Страницы: 1
RSS
Объединить команды внутри одной процедуры "Worksheet_Change"
 
Здравствуйте, мне нужно сделать выпадающий список с добавлением новых значений в нескольких столбцах, при добавлении двух процедур они естественно конфликтуют. (Чайник экселя)
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    Set p = Range("Номер")
    If Target.Cells.Count > 1 Then Exit Sub
    If IsEmpty(Target) Then Exit Sub
    If Not Intersect(Target, Range("B12:B37")) Is Nothing Then
        If WorksheetFunction.CountIf(p, Target) = 0 Then
            r = MsgBox("Добавить новое значение в справочник?", vbYesNo)
            If r = vbYes Then p.Cells(p.Rows.Count + 1) = Target
            End If
        End If
    End Sub
    Private Sub Worksheet_Change(ByVal Target As Range)
    Set p = Range("Время")
    If Target.Cells.Count > 1 Then Exit Sub
    If IsEmpty(Target) Then Exit Sub
    If Not Intersect(Target, Range("С12:С37")) Is Nothing Then
        If WorksheetFunction.CountIf(p, Target) = 0 Then
            r = MsgBox("Добавить новое значение в справочник?", vbYesNo)
            If r = vbYes Then p.Cells(p.Rows.Count + 1) = Target
            End If
        End If
    End Sub
 
они не конфликтуют, просто процедура с такая может быть  только одна и в ней надо делать ветвление при изменении и одного или другого. то есть INTERSECT применить дважды.
По вопросам из тем форума, личку не читаю.
 
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    Set a = Range("Номер")
    If Target.Cells.Count > 1 Then Exit Sub
    If IsEmpty(Target) Then Exit Sub
    If Not Intersect(Target, Range("B12:B37")) Is Nothing Then
    If WorksheetFunction.CountIf(a, Target) = 0 Then
            r = MsgBox("Добавить новое значение в справочник?", vbYesNo)
            If r = vbYes Then a.Cells(a.Rows.Count + 1) = Target
            Set a = Range("Время")
    If Not Intersect(Target, Range("C12:C37")) Is Nothing Then
        If WorksheetFunction.CountIf(b, Target) = 0 Then
            r = MsgBox("Добавить новое значение в справочник?", vbYesNo)
            If r = vbYes Then b.Cells(b.Rows.Count + 1) = Target
            End If
        End If
    End Sub

Изменено: Дмитрий Гончаренко - 15.07.2020 13:04:50
 
примерно уловили, но путаница у Вас в структуре If Else

Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 or IsEmpty(Target) Then Exit Sub
    If Not Intersect(Target, Range("B12:B37")) Is Nothing Then
        Set a = Range("Номер")
        If WorksheetFunction.CountIf(a, Target) = 0 Then
            r = MsgBox("Добавить новое значение в справочник?", vbYesNo)
            If r = vbYes Then a.Cells(a.Rows.Count + 1) = Target
         end if
    elseif Not Intersect(Target, Range("C12:C37")) Is Nothing Then
        Set a = Range("Время")        
        If WorksheetFunction.CountIf(b, Target) = 0 Then
            r = MsgBox("Добавить новое значение в справочник?", vbYesNo)
            If r = vbYes Then b.Cells(b.Rows.Count + 1) = Target
        End If
    End If
End Sub
По вопросам из тем форума, личку не читаю.
 
Помогло! Огромнейшее спасибо!  
 
"a" и "b" сидели на трубе....
Где "b" инициализировали?
 
Я поправил, теперь возникла уже другая проблема.
Страницы: 1
Наверх