В модуль листа "Опросник".
При условии, что в книге ничего не будет менять в плане заливки и кол-ва строк.
Код |
---|
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = 0
Application.EnableEvents = 0
Select Case Target.Text
Case Is = "Первичный рынок"
If Cells(17, 1).Interior.Color = 5296274 Then
Rows("14:16").Delete Shift:=xlUp
Application.CutCopyMode = False
End If
Range(Cells(11, 1), Cells(13, 5)).ClearContents
Cells(11, 1) = "Если подобрал квартиру на ПЕРВИЧНОМ рынке"
Cells(12, 1) = "ЖК / Застройщик"
Cells(13, 1) = "ДДУ/ПДКП/ДКП"
Case Is = "Вторичный рынок"
If Cells(17, 1).Interior.Color = 5296274 Then
Rows("14:16").Delete Shift:=xlUp
Application.CutCopyMode = False
End If
Range(Cells(11, 1), Cells(13, 5)).ClearContents
Cells(11, 1) = "Если подобрал квартиру на ВТОРИЧНОМ рынке"
Cells(12, 1) = "Кто является продавцом: физ/юр. лицо?"
Cells(13, 1) = "Что из себя представляет дом?"
Case Is = "Рефинансирование"
If Cells(14, 1).Interior.Color = 5296274 Then
For i = 1 To 3
Rows(14).Insert Shift:=xlDown
With Range(Cells(14, 2), Cells(14, 5))
.Merge
.Borders(xlEdgeLeft).LineStyle = xlContinuous
End With
Next
Range(Cells(11, 1), Cells(16, 5)).ClearContents
Cells(11, 1) = "Если это РЕФИНАНСИРОВАНИЕ:"
Cells(12, 1) = "Залоговый дисконт"
Cells(13, 1) = "Был ли использован материнский капитал?"
Cells(14, 1) = "Сделано ли 6 платежей?"
Cells(15, 1) = "Были ли просрочки за последние 6 месяцев?"
Cells(16, 1) = "В каком банке ипотека"
End If
End Select
Application.EnableEvents = 1
Application.ScreenUpdating = 1
End Sub
|