Option Explicit
Public Function Vznosi(Legal_Entity As String, ZP As Long, coefficient_FSS As Double, Nalogi_Full_PS As Double, Nalogi_Full_EOM As Double)
    If coefficient_FSS.Value = 12 Then
        If Legal_Entity = "12" Then
            Vznosi = ZP * NalogiFull_PS
        Else
            Vznosi = ZP * Nalogi_Full_EOM
        End If
    End If
End Function

Public Function Myfunc(Знач1 As Long, Знач2 As Long)   
    If Знач1 = Cell.Style = "Percent" Or Знач2 = Cell.Style = "Percent" Then
        Myfunc = "N/A"
    ElseIf Знач1 =1 Then
        Myfunc = Знач1
    ElseIf Знач2 =2 Then
        Myfunc = Знач2
End Function

Option Explicit
 
Sub FormatCell()
    Dim ColN As Integer, LastRow As Long, i As Long, Form As Long, st_ As Range, fn_ As Range
    ColN = InputBox("Укажите номер столбца для поиска диапазона", "Системное сообщение")
    Form = InputBox("Укажите номер столбца который надо форматировать", "Системное сообщение")
    LastRow = Cells(Rows.Count, ColN).End(xlUp).Row    'Определяем номер последней строки
    For i = 1 To LastRow
        If Val(Cells(i, ColN)) = 1 Then    'проверяем значение из ячейки на условие равное 1
            Set st_ = Cells(i, Form)
        End If
        If Val(Cells(i, ColN)) = 2 Then    'проверяем значение из ячейки на условие равное 2
            Set fn_ = Cells(i, Form)
            If Not st_ Is Nothing Then условноеФорматирование Range(st_, fn_)
            Set st_ = Nothing
            Set fn_ = Nothing
        End If
    Next
End Sub
 
 
Sub условноеФорматирование(r As Range)
    r.FormatConditions.AddColorScale ColorScaleType:=3
    r.FormatConditions(r.FormatConditions.Count).SetFirstPriority
    r.FormatConditions(1).ColorScaleCriteria(1).Type = _
    xlConditionValueLowestValue
    With r.FormatConditions(1).ColorScaleCriteria(1).FormatColor
        .Color = 8109667
        .TintAndShade = 0
    End With
    r.FormatConditions(1).ColorScaleCriteria(2).Type = _
    xlConditionValuePercentile
    r.FormatConditions(1).ColorScaleCriteria(2).Value = 50
    With r.FormatConditions(1).ColorScaleCriteria(2).FormatColor
        .Color = 8711167
        .TintAndShade = 0
    End With
    r.FormatConditions(1).ColorScaleCriteria(3).Type = _
    xlConditionValueHighestValue
    With r.FormatConditions(1).ColorScaleCriteria(3).FormatColor
        .Color = 7039480
        .TintAndShade = 0
    End With
End Sub

Option Explicit
Sub FormatCell()
    Dim ColN As Integer, LastRow As Long, i As Long, Form As Long
    ColN = InputBox("Укажите номер столбца для поиска диапазона", "Системное сообщение")
    Form = InputBox("Укажите номер столбца который надо форматировать", "Системное сообщение")
    LastRow = Cells(Rows.Count, ColN).End(xlUp).Row 'Определяем номер последней строки
    For i = LastRow To 1 Step -1 'Идем циклом снизу вверх чтоб не вызвать зацикливания
    If Val(Cells(i, ColN)) = 2 Then 'проверяем значение из ячейки на условие равное 2
      
    End If
  Next
End Sub

Sub выделение_ячейки()
    Range("B3:B13").Select
End Sub

Sub Форматирование()
    Selection.FormatConditions.AddColorScale ColorScaleType:=3
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _
        xlConditionValueLowestValue
    With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor
        .Color = 8109667
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _
        xlConditionValuePercentile
    Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50
    With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor
        .Color = 8711167
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _
        xlConditionValueHighestValue
    With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor
        .Color = 7039480
        .TintAndShade = 0
    End With
End Sub

Sub ОбъединениеЯчеек()
Dim RowIndex As Long
Dim StartRow As Long
Dim LastRow As Long
Dim ColumnToMerge As Long
    
    StartRow = 1 ' с какой строки начинать
    ColumnToMerge = 1 ' в какой колонке объединять

    LastRow = Cells(Rows.Count, ColumnToMerge).End(xlUp).Row

    Application.DisplayAlerts = False

    For RowIndex = StartRow + 1 To LastRow
        With Cells(RowIndex, ColumnToMerge)
            If .Value = .Offset(-1, 0).MergeArea.Cells(1).Value Then
                Range(Cells(RowIndex, ColumnToMerge), .Offset(-1, 0)).Merge
            End If
        End With
    Next RowIndex

    Application.DisplayAlerts = True
    
End Sub

Sub ОбъединениеЯчеекМод()
Dim RowIndex As Long
Dim StartRow As Long
Dim LastRow As Long
Dim ColumnToMerge As Long
Dim r As Long
Dim c As Long
    r = InputBox("С какой строки начать объединение?", "Системное сообщение")
    с = InputBox("В каком столбце искать значения?", "Системное сообщение")
    StartRow = r ' с какой строки начинать
    ColumnToMerge = c ' в какой колонке объединять

    LastRow = Cells(Rows.Count, ColumnToMerge).End(xlUp).Row

    Application.DisplayAlerts = False

    For RowIndex = StartRow + 1 To LastRow
        With Cells(RowIndex, ColumnToMerge)
            If .Value = .Offset(-1, 0).MergeArea.Cells(1).Value Then
                Range(Cells(RowIndex, ColumnToMerge), .Offset(-1, 0)).Merge
            End If
        End With
    Next RowIndex

    Application.DisplayAlerts = True
    
End Sub