Function ИЗВЛЕЧЬ_ЦЕЛЫЕ(ParamArray Диапазон())
'---------------------------------------------------------------------------------------
' Author       : Alex_ST, v__step, nerv
' URL          : http://www.excelworld.ru/forum/3-1012-12791-16-1324630051
' Topic        : Функция (UDF) "ИЗВЛЕЧЬЦЕЛЫЕ"
' Purpose      : Создать массив из целых чисел, извлечённых из текста произвольно расположенных ячеек
' Notes        : К полученному массиву можно применять любые стандартные формулы листа
'---------------------------------------------------------------------------------------
    Dim rArea, rCell, sStr$, oMatches, i&, Arr()
    On Error GoTo xlErrEXIT
    For Each rArea In Диапазон
       For Each rCell In IIf(rArea.Count = 1, Array(rArea.Value), rArea.Value)
          sStr = sStr & " " & rCell
       Next rCell
    Next rArea
    With CreateObject("VBScript.RegExp"): .Global = True: .Pattern = "\d+": Set oMatches = .Execute(sStr): End With
    If oMatches.Count = 0 Then ИЗВЛЕЧЬ_ЦЕЛЫЕ = CVErr(xlErrNA): Exit Function      ' вернуть ошибку #Н/Д если чисел нет
    '   If oMatches Is Nothing Then ИЗВЛЕЧЬ_ЦЕЛЫЕ = CVErr(xlErrNA): Exit Function   ' вернуть ошибку #Н/Д если чисел нет
    ReDim Arr(1 To oMatches.Count)
    For i = 0 To oMatches.Count - 1: Arr(i + 1) = CLng(oMatches(i).Value): Next i
    ИЗВЛЕЧЬ_ЦЕЛЫЕ = Arr
xlErrEXIT:    If Err Then ИЗВЛЕЧЬ_ЦЕЛЫЕ = CVErr(xlErrValue)   ' вернуть ошибку #ЗНАЧ! если была ошибка
End Function