=ЕСЛИ(ЕЧИСЛО(ПОИСКПОЗ(A3&B3&ТЕКСТ(C3;"ДД.ММ.ГГГГ")&D3;Лист2!$A$3:$A$29&Лист2!$B$3:$B$29&ТЕКСТ(Лист2!$C$3:$C$29;"ДД.ММ.ГГГГ")&Лист2!$D$3:$D$29;0));ИНДЕКС(Лист2!$A$3:$D$29;ПОИСКПОЗ(A3&B3&ТЕКСТ(C3;"ДД.ММ.ГГГГ")&D3;Лист2!$A$3:$A$29&Лист2!$B$3:$B$29&ТЕКСТ(Лист2!$C$3:$C$29;"ДД.ММ.ГГГГ")&Лист2!$D$3:$D$29;0);3);"Проба не совпала")

=ЕСЛИ(ЕЧИСЛО(ПОИСКПОЗ(A3&B3&ТЕКСТ(C3;"ДД.ММ.ГГГГ")&D3;Лист2!$A$3:$A$29&Лист2!$B$3:$B$29&ТЕКСТ(Лист2!$C$3:$C$29;"ДД.ММ.ГГГГ")&Лист2!$D$3:$D$29;0));"Проба совпала";"Проба не совпала")

=ВПР(--(ЕСЛИОШИБКА(ПОИСКПОЗ(A2;$F$2:$F$6;0);0)>0)&--(ЕСЛИОШИБКА(ПОИСКПОЗ(A2;$G$2:$G$6;0);0)>0);{"01";"только на складе 2":"10";"только на складе 1":"00";"нет":"11";"есть везде"};2;0)

=ТЕКСТ(ДАТАЗНАЧ(D5&" "&$K$3&" "&$S$3);"ДДД")

let
    Источник = Excel.CurrentWorkbook(){[Name="Таблица1"]}[Content],
    #"Другие столбцы с отмененным свертыванием" = Table.UnpivotOtherColumns(Источник, {"ФИО:"}, "Атрибут", "Значение"),
    #"Удаленные столбцы" = Table.RemoveColumns(#"Другие столбцы с отмененным свертыванием",{"Атрибут"})
in
    #"Удаленные столбцы"

    arr3 = Array(".", ",", "?", "!") ' символы которые должны быть удалены

    arr3 = Array(".", ",", "?", "!", "-", "_", "<", ">", "\", "/", "*", "+", "=", "(", ")") ' символы которые должны быть удалены

Sub Макрос1()
    Dim arr1, arr2, arr3, arr4, arr5, arr6, n As Long, m As Long, i As Integer, j As Integer
    On Error GoTo errrr
    arr1 = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    arr2 = Range("C1:C" & Cells(Rows.Count, 3).End(xlUp).Row)
    arr3 = Array(".", ",", "?", "!") ' символы которые должны быть удалены
    arr5 = Array("ая", "ой", "ей", "ий", "ие", "ый", "а", "и", "е", "у", "я", "ы") ' окончания которые должны быть удалены
    ReDim arr4(1 To UBound(arr1), 1 To 1)
    Set regex = CreateObject("VBScript.RegExp")
    regex.IgnoreCase = True
    For n = 2 To UBound(arr1)
        For m = 2 To UBound(arr2)
            pat = arr2(m, 1)
            For i = 0 To UBound(arr3)
                pat = Replace(pat, arr3(i), "")
            Next i
            arr6 = Split(pat, " ")
            For i = 0 To UBound(arr6)
                For j = 0 To UBound(arr5)
                    If Right(arr6(i), Len(arr5(j))) = arr5(j) Then arr6(i) = Left(arr6(i), Len(arr6(i)) - Len(arr5(j)))
                Next j
            Next i
            regex.Pattern = Join(arr6, "|")
            If regex.Test(arr1(n, 1)) Then rez = rez & Chr(10) & arr2(m, 1)
        Next m
        arr4(n, 1) = Mid(rez, 2)
        rez = ""
    Next n
    Range("E1:E" & Cells(Rows.Count, 1).End(xlUp).Row) = arr4
    Exit Sub
errrr:
    MsgBox "Возможно ошибка в ячейке: " & Cells(n, 1).Address
    Cells(n, 1).Select
End Sub

=ИНДЕКС({"Неуд":"Уд":"Хор":"Отл"};ОКРУГЛ(СУММ((C3:E3={"Неуд":"Уд":"Хор":"Отл"})*СТРОКА($1:$4))/СУММ(--(C3:E3={"Неуд":"Уд":"Хор":"Отл"}));0))

Sub Макрос1()
    Dim arr1, arr2, arr3, arr4, arr5, arr6, n As Long, m As Long, i As Integer, j As Integer
    arr1 = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    arr2 = Range("C1:C" & Cells(Rows.Count, 3).End(xlUp).Row)
    arr3 = Array(".", ",", "?", "!") ' символы которые должны быть удалены
    arr5 = Array("ая", "ой", "ей", "ий", "ый", "а", "и", "е", "у", "я", "ы") ' окончания которые должны быть удалены
    ReDim arr4(1 To UBound(arr1), 1 To 1)
    Set regex = CreateObject("VBScript.RegExp")
    regex.IgnoreCase = True
    For n = 2 To UBound(arr1)
        For m = 2 To UBound(arr2)
            pat = arr2(m, 1)
            For i = 0 To UBound(arr3)
                pat = Replace(pat, arr3(i), "")
            Next i
            arr6 = Split(pat, " ")
            For i = 0 To UBound(arr6)
                For j = 0 To UBound(arr5)
                    If Right(arr6(i), Len(arr5(j))) = arr5(j) Then arr6(i) = Left(arr6(i), Len(arr6(i)) - Len(arr5(j)))
                Next j
            Next i
            regex.Pattern = Join(arr6, "|")
            If regex.Test(arr1(n, 1)) Then rez = rez & Chr(10) & arr2(m, 1)
        Next m
        arr4(n, 1) = Mid(rez, 2)
        rez = ""
    Next n
    Range("E1:E" & Cells(Rows.Count, 1).End(xlUp).Row) = arr4
End Sub

Sub Макрос1()
    Dim arr1 As Variant, arr2 As Variant, arr3(1 To 4) As Variant, rng As Range, n As Integer, m As Integer, i As Byte, j As Byte
    lr1 = Worksheets("Хотелки").Cells(Rows.Count, 1).End(xlUp).Row
    arr1 = Worksheets("Хотелки").Range(Worksheets("Хотелки").Cells(2, 1), Worksheets("Хотелки").Cells(lr1, 3))
    With Worksheets("Желаемый результат")
        lr2 = .Cells(Rows.Count, 2).End(xlUp).Row
        arr2 = .Range(.Cells(4, 2), .Cells(lr2, 2))
        n = 1
        For m = 1 To UBound(arr2)
            If arr2(m, 1) = "ФИО" Then arr3(n) = m: n = n + 1
        Next
        arr3(4) = UBound(arr2)
        For n = 1 To UBound(arr1)
            If Month(CDate(arr1(n, 2))) <= 4 Then
                i = 1
            ElseIf Month(CDate(arr1(n, 2))) <= 8 Then
                i = 2
            Else
                i = 3
            End If
            If Month(CDate(arr1(n, 3))) <= 4 Then
                j = 1
            ElseIf Month(CDate(arr1(n, 3))) <= 8 Then
                j = 2
            Else
                j = 3
            End If
            For m = arr3(i) To arr3(i + 1)
                If arr1(n, 1) = arr2(m, 1) Then
                    If i > 1 Then c = DatePart("y", DateSerial(Year(arr1(n, 2)), (i - 1) * 4 + 1, 1) - 1) Else c = 0
                    d1 = DatePart("y", CDate(arr1(n, 2))) - c
                    If i = j Then
                        d2 = DatePart("y", CDate(arr1(n, 3))) - c
                        If rng Is Nothing Then Set rng = .Range(.Cells(m + 3, d1 + 3), .Cells(m + 3, d2 + 3)) Else Set rng = Union(rng, .Range(.Cells(m + 3, d1 + 3), .Cells(m + 3, d2 + 3)))
                    Else
                        d2 = DatePart("y", DateSerial(Year(arr1(n, 2)), Month(CDate(arr1(n, 3))), 1) - 1) - c
                        If rng Is Nothing Then Set rng = .Range(.Cells(m + 3, d1 + 3), .Cells(m + 3, d2 + 3)) Else Set rng = Union(rng, .Range(.Cells(m + 3, d1 + 3), .Cells(m + 3, d2 + 3)))
                        For m1 = arr3(j) To arr3(j + 1)
                            If arr1(n, 1) = arr2(m1, 1) Then
                                If j > 1 Then c = DatePart("y", DateSerial(Year(arr1(n, 3)), (j - 1) * 4 + 1, 1) - 1) Else c = 0
                                d1 = 1
                                d2 = DatePart("y", CDate(arr1(n, 3))) - c
                                If rng Is Nothing Then Set rng = .Range(.Cells(m1 + 3, d1 + 3), .Cells(m1 + 3, d2 + 3)) Else Set rng = Union(rng, .Range(.Cells(m1 + 3, d1 + 3), .Cells(m1 + 3, d2 + 3)))
                            End If
                        Next
                    End If
                End If
             Next
        Next
        If Not rng Is Nothing Then rng.Value = 1
    End With
End Sub

=СУММ(СЧЁТЕСЛИ($C$1:$C$5;ЛЕВСИМВ(A11)&ПОДСТАВИТЬ(ТЕКСТ(ПОСЛЕД(((--ПОДСТАВИТЬ(ПРАВСИМВ(СЖПРОБЕЛЫ(ФИЛЬТР.XML("<t><s>"&ПОДСТАВИТЬ(A11;"-";"</s><s>")&"</s></t>";"//s[2]"));ДЛСТР(СЖПРОБЕЛЫ(ФИЛЬТР.XML("<t><s>"&ПОДСТАВИТЬ(A11;"-";"</s><s>")&"</s></t>";"//s[2]")))-1);".";","))-(--ПОДСТАВИТЬ(ПРАВСИМВ(СЖПРОБЕЛЫ(ФИЛЬТР.XML("<t><s>"&ПОДСТАВИТЬ(A11;"-";"</s><s>")&"</s></t>";"//s[1]"));ДЛСТР(СЖПРОБЕЛЫ(ФИЛЬТР.XML("<t><s>"&ПОДСТАВИТЬ(A11;"-";"</s><s>")&"</s></t>";"//s[1]")))-1);".";",")))*10+1;1;(--ПОДСТАВИТЬ(ПРАВСИМВ(СЖПРОБЕЛЫ(ФИЛЬТР.XML("<t><s>"&ПОДСТАВИТЬ(A11;"-";"</s><s>")&"</s></t>";"//s[1]"));ДЛСТР(СЖПРОБЕЛЫ(ФИЛЬТР.XML("<t><s>"&ПОДСТАВИТЬ(A11;"-";"</s><s>")&"</s></t>";"//s[1]")))-1);".";","));0,1);"00,0");",";".")))

Private Sub CommandButton2_Click()
    lr = Cells(Rows.Count, 2).End(xlUp).Row + 1
    Cells(lr, 1) = CDate(TextBox1.Value)
    Cells(lr, 2) = ComboBox1.Value
    Cells(lr, 3) = TextBox3.Value
End Sub

Me.ListBox1.List = Range("A1:A3").Value

Me.ListBox2.RowSource = "A1:A3"

Private Sub CommandButton1_Click()
  Me.TextBox1.Text = Range("A1").Value
  Me.TextBox2.Value = Range("A1").Value
End Sub

Private Sub CommandButton2_Click()
 Range("A2").Value = Me.TextBox1
 Range("A3").Value = Me.TextBox1.Text
 Range("B2").Value = Me.TextBox2
 Range("B3").Value = Me.TextBox2.Text
End Sub