Public Function test(a, b)
Dim rez(1 To 4) As Double
rez(1) = a + b
rez(2) = a - b
rez(3) = a / b
rez(4) = a * b
test = rez
End Function

Function Fun_3(a#, b#, rez1 As Range, rez2 As Range) As Variant
    rez1.Replace rez1, a + b    
    rez2.Replace rez2, a - b    
    Fun_3 = "сумма в " & rez1.Address(0, 0) & ", разница в " & rez2.Address(0, 0)
End Function

x = Range("A1:J" & Cells(Rows.Count, 1).End(xlUp).Row).Value
    
    For i = 1 To UBound(x) 'расчет номера 1 строки реестра
        If x(i, 1) = "ГНН-0001" And CDate(x(i, 3)) = #1/1/2023# Then Exit For
    Next i
                    
    With Cells(i, 1).Resize(UBound(ArrAutofilterNew(x, "1=" & "ГНН-0001", "3=" & #1/1/2023#)), 10).Interior
    'раскраска ячеек
    End With

Private Sub CommandButton1_Click()
    x = Range("A1:J" & Cells(Rows.Count, 1).End(xlUp).Row).Value
    
    For i = 1 To UBound(x) 'расчет номера 1 строки реестра
        If x(i, 1) = "ГНН-0001" And CDate(x(i, 3)) = #1/1/2023# Then Exit For
    Next i
                    
    With Cells(i, 1).Resize(UBound(ArrAutofilterNew(x, "1=" & "ГНН-0001", "3=" & #1/1/2023#)), 10).Interior
    'раскраска ячеек
    End With
    Debug.Print rFirst
    
End Sub

'---------------------------------------------
Public rFirst As Long
Function ArrAutofilterNew(ByRef arr, ParamArray args() As Variant) As Variant   ' Новая версия функции ArrAutofilter, от января 2021 года.  © ExcelVBA.ru
    ' Получает по ссылке массив ARR для фильтрации
    ' и список критериев фильтрации в формате "3=маска текста" (номер столбца, "=", искомое значение)
    ' Возвращает двумерный массив с подходящими строками
     
    On Error Resume Next
    ArrAutofilterNew = False ' возвращаемое значение в случае ошибки
    If UBound(args) = -1 Then Debug.Print "Array filtering error: filters required": Exit Function
    ReDim Filters(1 To UBound(args) + 1, 1 To 2)
  
    Dim i&, ColumnToCheck&, FiltersCount&, j&, ro&, RowsCount&:  Err.Clear: i& = UBound(arr, 2)
    If Err.Number > 0 Then Debug.Print "Array filtering error: two dimensional array required": Exit Function
  
    For i& = LBound(args) To UBound(args)    ' перебираем все параметры фильтрации
        If Not IsMissing(args(i&)) Then
            If args(i&) Like "#*=*" Then ' распознаем параметры фильтрации
                FiltersCount& = FiltersCount& + 1
                Filters(FiltersCount&, 1) = Val(Split(args(i&), "=")(0)) ' столбец массива
                Filters(FiltersCount&, 2) = Split(args(i&), "=", 2)(1) ' маска для значения
            Else ' неверно заданный фильтр
                Debug.Print "ArrAutofilterNew error: invalid filter «" & args(i&) & "»"
            End If
        End If
    Next i&
    If FiltersCount& = 0 Then Debug.Print "Array filtering error: all filters are empty": Exit Function
  
    ReDim arrCheck(LBound(arr, 1) To UBound(arr, 1)) As Boolean ' для результатов проверки
    For i = LBound(arr, 1) To UBound(arr, 1)    ' перебираем все строки массива, и проверяем их
        arrCheck(i) = True
        For j& = 1 To FiltersCount&    ' перебираем все параметры фильтрации
            If Not (arr(i, Filters(j&, 1)) Like Filters(j&, 2)) Then arrCheck(i) = False: Exit For
        Next j&
        RowsCount& = RowsCount& - arrCheck(i) ' увеличиваем счётчик подходящих строк на 1
    Next i
    If RowsCount& = 0 Then Exit Function ' выход, если нет ни одной подходящей строки в массиве
     
    ReDim newarr(1 To RowsCount&, LBound(arr, 2) To UBound(arr, 2)) ' формируем новый массив
    For i = LBound(arr, 1) To UBound(arr, 1)    ' снова перебираем все строки массива
        If arrCheck(i) Then ' если строка ранее помечена как подходящая
            ro& = ro& + 1 ' вычисляем номер строки в новом массиве
            If rFirst = 0 Then rFirst = i
            For j = LBound(arr, 2) To UBound(arr, 2)
                newarr(ro&, j) = arr(i, j) ' заполняем массив значениями из исходного
            Next j
        End If
    Next i
    ArrAutofilterNew = newarr ' возвращаем результат
    Erase arrCheck
End Function

Private Sub CommandButton1_Click()
    x = Range("A1:J" & Cells(Rows.Count, 1).End(xlUp).Row).Value
    
    For i = 1 To UBound(x) 'расчет номера 1 строки реестра
        If x(i, 1) = "ГНН-0001" And CDate(x(i, 3)) = #1/1/2023# Then Exit For
    Next i
                    
    With Cells(i, 1).Resize(UBound(ArrAutofilterNew(x, "1=" & "ГНН-0001", "3=" & #1/1/2023#)), 10).Interior
    'раскраска ячеек
    End With
    
    Debug.Print ArrAutofilterNew_GetRfirst(x, "1=" & "ГНН-0001", "3=" & #1/1/2023#)
End Sub

Function ArrAutofilterNew_GetRfirst(ByRef arr, ParamArray args() As Variant) As Variant   ' Новая версия функции ArrAutofilter, от января 2021 года.  © ExcelVBA.ru

    Dim RowsCount&, i As Long, j As Long, arrCheck As Variant

    arrCheck = GetArrCheck(arr, RowsCount, args)

    For i = LBound(arr, 1) To UBound(arr, 1)    ' снова перебираем все строки массива
        If arrCheck(i) Then ' если строка ранее помечена как подходящая
            ArrAutofilterNew_GetRfirst = i
            Exit Function
        End If
    Next i
End Function

Function ArrAutofilterNew(ByRef arr, ParamArray args() As Variant) As Variant   ' Новая версия функции ArrAutofilter, от января 2021 года.  © ExcelVBA.ru

    Dim RowsCount&, i As Long, j As Long, arrCheck As Variant, ro&

    arrCheck = GetArrCheck(arr, RowsCount, args)

    ReDim newarr(1 To RowsCount&, LBound(arr, 2) To UBound(arr, 2)) ' формируем новый массив
    For i = LBound(arr, 1) To UBound(arr, 1)    ' снова перебираем все строки массива
        If arrCheck(i) Then ' если строка ранее помечена как подходящая
            ro& = ro& + 1 ' вычисляем номер строки в новом массиве
            For j = LBound(arr, 2) To UBound(arr, 2)
                newarr(ro&, j) = arr(i, j) ' заполняем массив значениями из исходного
            Next j
        End If
    Next i
    ArrAutofilterNew = newarr ' возвращаем результат
End Function

Function GetArrCheck(ByRef arr, RowsCount&, ParamArray args() As Variant) As Variant
    On Error Resume Next
    GetArrCheck = False ' возвращаемое значение в случае ошибки
    If UBound(args) = -1 Then Debug.Print "Array filtering error: filters required": Exit Function
    ReDim Filters(1 To UBound(args(0)) + 1, 1 To 2)

    Dim i&, ColumnToCheck&, FiltersCount&, j&:  Err.Clear: i& = UBound(arr, 2)
    If Err.Number > 0 Then Debug.Print "Array filtering error: two dimensional array required": Exit Function

    For i& = LBound(args(0)) To UBound(args(0))    ' перебираем все параметры фильтрации
        If Not IsMissing(args(0)(i&)) Then
            If args(0)(i&) Like "#*=*" Then ' распознаем параметры фильтрации
                FiltersCount& = FiltersCount& + 1
                Filters(FiltersCount&, 1) = Val(Split(args(0)(i&), "=")(0)) ' столбец массива
                Filters(FiltersCount&, 2) = Split(args(0)(i&), "=", 2)(1) ' маска для значения
            Else ' неверно заданный фильтр
                Debug.Print "ArrAutofilterNew error: invalid filter «" & args(0)(i&) & "»"
            End If
        End If
    Next i&
    If FiltersCount& = 0 Then Debug.Print "Array filtering error: all filters are empty": Exit Function

    ReDim arrCheck(LBound(arr, 1) To UBound(arr, 1)) As Boolean ' для результатов проверки
    For i = LBound(arr, 1) To UBound(arr, 1)    ' перебираем все строки массива, и проверяем их
        arrCheck(i) = True
        For j& = 1 To FiltersCount&    ' перебираем все параметры фильтрации
            If Not (arr(i, Filters(j&, 1)) Like Filters(j&, 2)) Then arrCheck(i) = False: Exit For
        Next j&
        RowsCount& = RowsCount& - arrCheck(i) ' увеличиваем счётчик подходящих строк на 1
    Next i
    If RowsCount& = 0 Then Exit Function ' выход, если нет ни одной подходящей строки в массиве
    GetArrCheck = arrCheck
End Function