=ПРОСМОТР(2;1/(Таблица2[@Менеджер]=Таблица1[ФИО])/(Таблица2[@Дата]>=Таблица1[Дата изменения]);ВЫБОР(ПОИСКПОЗ(Таблица2[@[Статья 4 уровень]];{"Заработная плата на руки":"НДФЛ"};0);Таблица1[Оклад];Таблица1[НДФЛ]))

Function SumSlash(txt As String, Optional delim As String = "/") As Long    Dim s As Long, x As Variant
    For Each x In Split(txt, delim)
        s = s + Val(x)
    Next x
    SumSlash = s
End Function

Dim cl As Range
Dim rngHead As Range
 
Sub TestMerge()
Call MergeHeadSmart(Selection)
End Sub

Sub MergeHeadSmart(r As Range)
  Set rngHead = r
  rngHead.UnMerge
  For Each cl In rngHead
    If GoDown Then Range(cl, cl.Offset(1, 0)).Merge
    If GoRight Then Range(cl, cl.Offset(0, 1)).Merge
  Next cl
'  rngHead.HorizontalAlignment = xlCenter
'  rngHead.VerticalAlignment = xlCenter
End Sub
 
Private Function GoRight()
  GoRight = False
  If IsEmpty(cl.Offset(0, 1)) And _
    cl.Offset(0, 1).Column <= rngHead.Columns(rngHead.Columns.Count).Column And _
      RowsCount(cl) = 1 And RowsCount(cl.Offset(0, 1)) = 1 Then _
      GoRight = True
End Function
 
Private Function GoDown()
  GoDown = False
  If IsEmpty(cl.Offset(1, 0)) And _
    cl.Offset(1, 0).Row <= rngHead.Rows(rngHead.Rows.Count).Row And _
      ColumnsCount(cl) = 1 Then
    GoDown = True
  End If
End Function
 
Private Function ColumnsCount(ByRef c As Range)
  Dim mRng As Range
  Set mRng = c.MergeArea
  Debug.Print mRng.Address
  ColumnsCount = mRng.Columns.Count
End Function
 
Private Function RowsCount(ByRef c As Range)
  Dim mRng As Range
  Set mRng = c.MergeArea
  RowsCount = mRng.Rows.Count
End Function

Sub MergeHeadTest2()
Dim mas() As Long
Dim sel As Range
Dim cl As Range
Dim r, c, i As Long
Set sel = Selection
sel.UnMerge
r = 1
c = 1
i = 1
For c = 1 To sel.Columns.Count
    If sel.Cells(r, c).Value <> "" Then
        If c - i = 1 Then
            Range(sel.Cells(r, i), sel.Cells(sel.Rows.Count, i)).Merge
            i = i + 1
        ElseIf c - i > 1 Then
            Range(sel.Cells(r, i), sel.Cells(r, c - 1)).Merge
        End If
    End If
Next c
End Sub

Sub MergeHeadTest()
'Объединение ячеек в заголовке
Dim i As Integer
Dim j As Integer
Dim g As Range
Dim mas()
Set g = Selection
    With g
        For i = 1 To .Columns.Count
            If .Cells(1, i).Value <> "" Then
                j = j + 1
                ReDim Preserve mas(1 To j)
                mas(j) = i
            End If
        Next i
        If mas(UBound(mas)) <> .Columns.Count Then
            j = j + 1
            ReDim Preserve mas(1 To j)
            mas(j) = .Columns.Count
        End If
        For i = LBound(mas) To UBound(mas)
            If i = UBound(mas) Then
                Range(.Cells(1, mas(i)), .Cells(1, mas(i))).Merge
            Else
                Range(.Cells(1, mas(i)), .Cells(1, mas(i + 1) - 1)).Merge
            End If
        Next i
        If .Rows.Count > 1 Then
            For i = LBound(mas) To UBound(mas)
                If i = UBound(mas) Then
                    Range(.Cells(1, mas(i)), .Cells(1, mas(i))).Merge
                Else
                    Range(.Cells(1, mas(i)), .Cells(1, mas(i + 1) - 1)).Merge
                End If
            Next i
        End If
    End With

End Sub

Sub Test()
Dim rng as Range
'Выделяем текущую область
Set rng = Activecell.CurrentRegion
rng.Select
End Sub