Public Function io(ByRef Argument As String) As Variant
Dim x, v, z, k As New Collection
With CreateObject("VBScript.RegExp")
      .Global = True: .Pattern = "[^0-9]"
      For Each v In Split(Argument, ";"): Set v = Range(v)
          For Each x In IIf(v.Count = 1, Array(v.Value), v.Value)    'If одна ячейка Then cоздать массив Else цикл по массиву : )
              If Not IsError(x) Then
                  For Each z In Split(Application.Trim(.Replace(x, " ")))
                      k.Add CLng(z)
                  Next
              End If
          Next
      Next
End With
If k.Count = 0 Then io = CVErr(xlErrNA): Exit Function
ReDim v(1 To k.Count)
For x = 1 To k.Count: v(x) = k.Item(x): Next: io = v
End Function

For Each x In IIf(v.Count = 1, Array(v.Value), v.Value)

Function ИЗВЛЕЧЬЦЕЛЫЕ(ParamArray ЯЧЕЙКА())    ' создать массив из целых чисел, выбранных из текста произвольно расположенных ячеек
      '---------------------------------------------------------------------------------------
      ' Procedure    : ИЗВЛЕЧЬЦЕЛЫЕ
      ' Author       : Alex_ST
      ' DateTime     : 21.11.11, 12:15
      ' Purpose      : создать массив из целых чисел, извлечённых из текста произвольно расположенных ячеек
      ' Notes        : К полученному массиву можно применять любые стандартные формулы листа
      ' Notes        : Если цифр в ячейках-аргументах функции нет, то возвращается КОРРЕКТНОЕ #Н/Д
      '---------------------------------------------------------------------------------------
      Dim rArea, rCell, Arr0, sStr$, i&, j&
      Dim Arr(): ReDim Arr(1 To 1)   ' чтобы нумерация массива начиналась с 1
      On Error GoTo xlErrEXIT
      With CreateObject("VBScript.RegExp"): .Global = True: .Pattern = "[^0-9]"
         For Each rArea In ЯЧЕЙКА   ' в каждой из областей
            For Each rCell In IIf(rArea.Count = 1, rArea, rArea.Value)   ' в каждой из ячеек
               Arr0 = Split(Application.Trim(.Replace(rCell, " ")))   ' массив целых чисел, выбранный из ячейки (LBound=0)
               If UBound(Arr0) > -1 Then   ' если чисел нет, то UBound = -1
                  j = UBound(Arr)
                  ReDim Preserve Arr(1 To UBound(Arr) + UBound(Arr0) + 1)
                  For i = 0 To UBound(Arr0): Arr(j + i) = CLng(0 & Arr0(i)): Next i
               End If
            Next rCell
         Next rArea
      End With
      If UBound(Arr) = 1 Then ИЗВЛЕЧЬЦЕЛЫЕ = CVErr(xlErrNA): Exit Function      ' вернуть ошибку #Н/Д если чисел нет
      ReDim Preserve Arr(1 To UBound(Arr) - 1)      ' убрать последний (лишний) элемент массива
      ИЗВЛЕЧЬЦЕЛЫЕ = Arr
xlErrEXIT:    If Err Then ИЗВЛЕЧЬЦЕЛЫЕ = CVErr(xlErrValue): Exit Function   ' вернуть ошибку #ЗНАЧЕНИЕ если была ошибка в аргументах

End Function

Sub test_ИЗВЛЕЧЬЦЕЛЫЕ()
      With Лист2
         .[A1] = "1 бык и 2 коровы"
         .[B1] = "3 барана,4 овцы"
         .[C1] = "всего 5 кур; 6 гусей"
         .[D1] = CVErr(xlErrNA)
      End With
      Dim i%, Arr
      Arr = ИЗВЛЕЧЬЦЕЛЫЕ(Лист2.[A1], Лист2.[B1:C1])
      If VarType(Arr) = vbError Then Debug.Print "No numbers in string": Exit Sub
      For i = LBound(Arr) To UBound(Arr): Debug.Print i, Arr(i): Next i
End Sub

Public Function io(ParamArray Arguments()) As Variant
Dim v, x, i
With CreateObject("VBScript.RegExp")
      .Global = True: .Pattern = "[^0-9]"
      For Each v In Arguments
          For Each x In IIf(v.Count = 1, Array(v.Value), v.Value)
              i = i & " " & Application.Trim(.Replace(x, " "))
          Next
      Next
      x = Split(LTrim(i)): ReDim v(1 To UBound(x) + 1)
      For i = 0 To UBound(x): v(i + 1) = CLng(x(i)): Next
      io = v
End With
End Function