Страницы: 1
RSS
Создание новой строки, объединение ячеек и изменение формата ячеек при выполнении условия
 
Всем доброго времени суток!
Excel 2016. Требуется следующее:
В случае, если в какой-либо ячейке столбца G устанавливается значение "Да", снизу от этой ячейки добавляется новая строка, затем в этих двух строках объединяются столбцы A - G, I - L (т.е. остается нетронутым только H, чтобы к одному контракту можно было вписать две даты).
Далее меняются числовые форматы ячейки: у ячейки верхней (из двух) строки - формат "ДД.ММ.ГГГГ \Дата протокола", у нижней - "ДД.ММ.ГГГГ \Дата по\дпи\сания".

Подскажите, пожалуйста, как это сделать?
Реестр1 - исходный вариант,
Реестр2 - вариант с выполненным требованием.
 
В модуль листа.
Будет срабатывать после внесения "Да" в столбец G.
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count = 1 Then
        If Not Intersect(Target, Columns("G:G")) Is Nothing Then
            If Target.Value = "Да" Then
                AddRow Target.Row
            End If
        End If
    End If
End Sub

Sub AddRow(y As Long)
    With ActiveSheet
        If .Cells(y, 1).MergeArea.Cells.Count = 1 Then
            .Rows(y + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Dim x As Integer
            For x = 1 To [L1].Column
                If x <> [H1].Column Then
                    .Cells(y, x).Resize(2).Merge
                End If
            Next
            With .Cells(y + 0, [H1].Column)
                .Cells(1, 1).NumberFormat = "dd/mm/yyyy Дата протокола"
                .Cells(2, 1).NumberFormat = "dd/mm/yyyy Дата подписания"
                .Cells(2, 1).Value = .Cells(1, 1).Value
            End With
        End If
    End With
End Sub
Изменено: МатросНаЗебре - 10.01.2022 16:31:42
 
Лена Полева , ЗАБЫЛ  о формате, но кстати объединение зло,
Код
Sub meshkei()
Dim i As Long, n As Long, lr As Long
Application.DisplayAlerts = False
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(xlUp).Row
For i = lr To 2 Step -1
    If Cells(i, 7) = "Да" And Cells(i, 7) <> "" Then
        Rows(i + 1 & ":" & i + 1).Insert
        For n = 1 To 12
            If n <> 8 Then
                Range(Cells(i, n), Cells(i + 1, n)).Merge
            Else
            Cells(i, n).NumberFormat = "dd/mm/yyyy Дата протокола"
             Cells(i + 1, n).NumberFormat = "dd/mm/yyyy Дата подписания"
            End If
        Next n
    End If
Next i
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub



Изменено: Mershik - 10.01.2022 16:48:52
Не бойтесь совершенства. Вам его не достичь.
 
МатросНаЗебре, спасибо, сработало!
Подскажите, а возможно ли как-то сделать так, чтобы после срабатывания правила условного форматирования верхней ячейки применялись на новую нижнюю ячейку H? (где Дата подписания)
Mershik, а Ваш вариант у меня почему-то не сработал :(  
Изменено: Лена Полева - 11.01.2022 08:15:06
 
Цитата
написал:
сделать так, чтобы после срабатывания правила условного форматирования верхней ячейки применялись на новую нижнюю ячейку H
Как вариант, можно поменять правила условного форматирования.
Запустите этот макрос один раз.
Код
Sub EditFormatConditions()
    
    Cells.FormatConditions.Delete
    With Range("A2:L201")
        .FormatConditions.Add Type:=xlExpression, Formula1:="=ЕСЛИ(И($A2="""";$H2<>"""");$J1;$J2)=AA"
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 5296274
            .TintAndShade = 0
        End With
        .FormatConditions(1).StopIfTrue = False
        .FormatConditions.Add Type:=xlExpression, Formula1:="=ЕСЛИ(И($A2="""";$H2<>"""");$J1;$J2)=AAA"
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 15773696
            .TintAndShade = 0
        End With
        .FormatConditions(1).StopIfTrue = False
        .FormatConditions.Add Type:=xlExpression, Formula1:="=ЕСЛИ(И($A2="""";$H2<>"""");$J1;$J2)=BB"
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent4
            .TintAndShade = 0.399945066682943
        End With
        .FormatConditions(1).StopIfTrue = False
    End With
End Sub
Страницы: 1
Наверх