Private Sub CommandButton1_Click()
    Dim arr(), sht As Worksheet, i&
    Set sht = Worksheets("Календарь")
    arr = sht.Range("c3:c" & sht.Range("c" & sht.Rows.Count).End(xlUp).Row).Value
    For i = 1 To UBound(arr)
        If arr(i, 1) = ComboBox1.Value Then MsgBox "Есть такая строка в массиве!", vbInformation: Exit Sub
    Next i
    MsgBox "Строка в массиве не найдена!", vbInformation
End Sub

For i = 1 To 40000 Step 10
   Range("a" & i).Resize(10, 5).Select
   Application.Wait Now + TimeSerial(0, 0, 9)
Next i

Sub main()
    Dim arr(), txt$, i&
    arr = [a1].CurrentRegion.Value
    [b:b].ClearContents
    For i = 1 To UBound(arr)
        txt = Trim(Left(arr(i, 1), InStrRev(arr(i, 1), " ")))
        arr(i, 1) = Trim(Left(txt, InStrRev(arr(i, 1), " ")))
    Next
    arr(1, 1) = "Результат"
    [b1].Resize(UBound(arr)).Value = arr
End Sub

Sub main()
    Dim arr1(), arr2(), i&, j&, txt$
    arr1 = Worksheets("Лист1").[a1].CurrentRegion.Value
    arr2 = Worksheets("Лист2").[a1].CurrentRegion.Value
    For i = 2 To UBound(arr1)
        For j = 2 To UBound(arr2)
            txt = Join(Array("*", arr1(i, 1), "*"), "")
            If arr2(j, 1) Like txt Then arr1(i, 2) = arr2(j, 2): Exit For
        Next j
    Next i
    Worksheets("Лист1").[a1].Resize(UBound(arr1), UBound(arr1, 2)).Value = arr1
End Sub