let
    Source = Excel.CurrentWorkbook(){[Name="1sd"]}[Content],
    originalOrder = Table.AddIndexColumn(Source, "id"),
    local = Table.Group(originalOrder, {"OKRID"}, {"temp", (sub) =>
        Table.AddColumn(sub, "Маркер", each if [DATE_V] = List.Max(sub[DATE_V]) then "Да" else "Нет")
    })[temp],
    common = Table.Combine(local),
    #"Sorted Rows" = Table.Sort(common,{{"id", Order.Ascending}}),
    result = Table.RemoveColumns(#"Sorted Rows", {"id"})
in
    result

Cells(1,1) = "5"
Cells(1,1).Value = "5"

sub test()
Set prom = Workbooks.Open("C:\Users\Gumin-AA\Desktop\sever.xlsx")
Set svod = Workbooks.Open("C:\Users\Gumin-AA\Desktop\ugeas.xlsm")
Set reestr = svod.Sheets("jenk")
Set zakl = prom.Sheets("Лист1")
Set otkl = prom.Sheets("Лист3")

lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
data_now = InputBox("Введите нужную дату (полностью, в формате dd-mm-yyyy)", "Введите дату", Date)
data_now = CDate(data_now)

For j = 2 To lLastRow&
    zakl.Activate
    If Cells(j, 5) = data_now  Or Cells(i, 3) = DateAdd("d", -4, data_now)  And Cells(j, 4) = "принята" Then
        inn = Cells(j, 11)
        summ_deal = Cells(j, 31)
        reestr.Activate 'такой метод не устраивает
        For l = 2 To lLastRow&
            If Cells(l, 5) = inn And Cells(l, 12) = "все норм" Or Cells(l, 12) = "тоже норм" And Cells(l, 15) = "Да" Then
                Cells(l, 12).Value = "Пшено есть"
                Cells(l, 11).Value = data_now
                Cells(l, 20).Value = summ_deal  'If Cells(l, 20).Value = "" Then
                Exit For
            End If
        Next l
    End If
Next j
End sub

Private Sub Send_Mail()
    Dim objOutlookApp As Object, objMail As Object

Application.ScreenUpdating = False

    On Error Resume Next
    Set objOutlookApp = CreateObject("Outlook.Application")
    objOutlookApp.Session.Logon
    Set objMail = objOutlookApp.CreateItem(0)   'создаем новое сообщение
    If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub
    On Error GoTo 0
    'создаем сообщение
    With objMail
        .To = "Ответственные"
        .CC = _
        "Ssdasf@mail.ru"
        .Subject = _
        "Инфо "
       .BodyFormat = 2  'olFormatHTML - формат HTML
        .HTMLBody = _
        "Lобрый день. <br>."
        .display 'отображаем сообщение
    End With

Set objOutlookApp = Nothing: Set objMail = Nothing
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub

Sub XML_Replace()

    Dim s, Stroka2 As String
    Dim myRegExp As New RegExp  
    
With myRegExp
    .Global = True 
    .IgnoreCase = False 
    .MultiLine = False 
    .Pattern = ">\d{10}<|>\d{12}|>\d{13}<|>\d{15}<|>((8|\+7)[\- ]?)?(\(?\d{3}\)?[\- ]?)?[\d\- ]{7,10}<"
End With

Stroka2 = ">ПРАВЛЕНО<"

    Open "C:\Users\17620635\Desktop\testxml.txt" For Input As #1 'Открываем файл функцией Open() на чтение(Input)
    Open "C:\Users\17620635\Desktop\outputxml.txt" For Output As #4
    
    While Not EOF(1)
        Line Input #1, s
        s = myRegExp.Replace(s, Stroka2)
        Print #4, s
    Wend
    
    MsgBox vbInformation
    Close #1
    Close #4
End Sub

If pat = ">\d{10}<|>\d{12}<" Then:
StrN = "INN>ПРАВЛЕНО<"
ElseIf pat = ">\d{13}<|>\d{15}<" Then:
StrN = "OGRN>ПРАВЛЕНО<"
ElseIf pat = ">((8|\+7)[\- ]?)?(\(?\d{3}\)?[\- ]?)?[\d\- ]{7,10}<" Then:
StrN = "Telephone>ПРАВЛЕНО<"

 
Private Sub Send_Mail()
    Dim objOutlookApp As Object, objMail As Object
    Application.ScreenUpdating = False
    On Error Resume Next
    Set objOutlookApp = CreateObject("Outlook.Application")
    objOutlookApp.Session.Logon
    Set objMail = objOutlookApp.CreateItem(0)   'создаем новое сообщение
    If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub
    On Error GoTo 0
    'создаем сообщение
    With objMail
        .To = otvetvstvenie("value")
        .CC = _
        "inbox@mail.ru; seraga@mail.ru"
        .Subject = _
        "тема сообщения"
       .BodyFormat = 2  'olFormatHTML - формат HTML
        .HTMLBody = _
        "Добрый день, направляю дедлайны." & "ConvertRngToHTM(Selection)"
        .display 'отображаем сообщение
    End With
 
    Set objOutlookApp = Nothing: Set objMail = Nothing
    Application.ScreenUpdating = True
End Sub
 
Function otvetvstvenie(bank As String) 
 
Dim lLastRow As Long, bank As String
lLastRow = Cells(Rows.Count, 4).End(xlUp).Row

Application.Workbooks("Ответственные.xlsx").Sheets("Лист1").Activate
Range("C4").AutoFilter Field:=2, Criteria1:=bank
Range("F5" & ":F" & lLastRow).Copy
End Function