Function GetMonth(ByVal strDate As String) As Integer
    Dim i As Integer
    Static arr(1 To 12) As String
    If arr(1) = "" Then
        For i = 1 To 12
            arr(1 + (i + 8) Mod 12) = WorksheetFunction.Text(DateSerial(1900, i, 1), "[$-160429]mmmm")
        Next i
    End If
  
    For i = 1 To 12
        If StrComp(strDate, arr(i), vbTextCompare) = 0 Then
            GetMonth = i
            Exit For
        End If
    Next i
End Function

Function GetMonth(ByVal strDate As String) As Integer
Static arr
If Not IsArray(arr) Then
  arr = Range("d_months")
End If
For i = 1 To 12
    If StrComp(strDate, arr(i, 1), vbTextCompare) = 0 Then
        GetMonth = i
        Exit For
    End If
Next i
End Function

Function IsPersianDate(ByVal s As String) As Boolean
  Dim d
  On Error Resume Next
  d = Gdate(s)
  On Error GoTo 0
  IsPersianDate = Not IsEmpty(d)
End Function

Function Gdate(ByVal cell)
  Dim arr, d As Long, m As Long, y As Long
  arr = Split(cell)
  d = ToDbl(arr(0))
  m = GetMonth(arr(1))
  y = ToDbl(arr(2))
  Gdate = toGregorianDateObject(y, m, d)
End Function

Private Function ToDbl(ByVal s)
  ToDbl = Application.Evaluate("--" & s)
End Function

Function GetMonth(ByVal strDate As String) As Integer
For i = 1 To 12
    If InStr(strDate, WorksheetFunction.Text(i * 28, "[$-160429]mmmm")) <> 0 Then
        GetMonth = 1 + ((i + 8) Mod 12)
    Exit For
    End If
Next
End Function

=ДАТА(ПСТР(A2;1;4);ПСТР(A2; 5;2);ПСТР(A2;7;2))

Option Explicit
Function GetVisibleRangeHeight()
 Dim r As Range, n As Long, i As Long, h_old As Double, h As Double, row As Range
 With ActiveWindow
   Set r = .VisibleRange
   n = r.Rows.Count
   Set r = r.Resize(n - 1)       ' отбросили последнюю строку, которая может быть видна не полностью
   Set row = Rows(r.row + n - 2) ' последняя строка r
   h_old = row.RowHeight         ' и ее высота
   h = h_old
   Do While True
     h = h + 0.25
     row.RowHeight = h
     If .VisibleRange.Rows.Count <> n Then
       Exit Do
     End If
   Loop
   row.RowHeight = h - 0.25      ' вернули предыдущую высоту
   
   GetVisibleRangeHeight = r.Height
   row.RowHeight = h_old
  End With
End Function

Sub test1()
  Dim valTB
  valTB = UserForm1.TextBox1.Value
  If IsNumeric(valTB) Then
    valTB = CDbl(valTB) ' преобразовали в Double
  Else  ' в Textbox введено не число
    ' ...
  End If
End Sub

Sub DeleteErrorName()
    Dim n As Name
    Dim count As Integer
    If MsgBox("Удалить в книге все имена с ошибочными значениями? (без возможности востановления)", vbQuestion + vbYesNo) = vbYes Then
        On Error Resume Next
        For Each n In ActiveWorkbook.Names
            If n.Value Like "=[#]*" Then
                n.Delete
                If Err = 0 Then
                    count = count + 1
                Else
                    MsgBox "Ошибка при удалении имени " & n.Name
                    Err.Clear
                End If
            End If
        Next n
        MsgBox "Удалено имён - " & count
    End If
End Sub

=НЕ(И(ЕОШИБКА(ПОИСК("*"&A1&" *";B1&" "));ЕОШИБКА(ПОИСК("*"&A1&",*";B1&","))))

=ОКРУГЛ($B3/5*СТОЛБЕЦ(A3);0)-СУММ($C3:C3)

#If Win64 Then
Type GENERALINPUT: dwType As LongPtr: xi(0 To 31) As Byte: End Type
#Else
Type GENERALINPUT: dwType As LongPtr: xi(0 To 23) As Byte: End Type
#End If
Declare PtrSafe Function SendInput Lib "user32.dll" (ByVal nInputs As LongPtr, pInputs As GENERALINPUT, ByVal cbSize As Long) As Long
Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)

Sub test()
  AppActivate "Блокнот"
  With CreateObject("WScript.Shell")
    .SendKeys "HELLO"
  End With
End Sub