Извлечение части данных из одной ячейки макросом

Function Julia(ByVal s As String) As String
Dim x, v$(), i&
  v = Split(s, "Цвет:")
  For i = 1 To UBound(v)
    s = LTrim$(v(i)) & " "
    Julia = Julia & ", " & Left$(s, InStr(s, " ") - 1)
  Next
  Julia = Mid$(Julia, 3)
End Function

 Function uuu(st As String)
     With CreateObject("vbscript.regexp")
     .Global = True
     .IgnoreCase = True
     .Pattern = "[A-Я]{4}\-[А-Я]{5,7}"
      uuu = .Execute(st)(0).Value
   End With
End Function

Function zzz(st As String)
   With CreateObject("vbscript.regexp")
     .Global = True
     .Pattern = "[0-9]{3}"
      zzz = .Execute(st)(1).Value
   End With
End Function

Function aaa(st As String)
       Dim t1$, t2$, t3$
       With CreateObject("vbscript.regexp")
         .Global = True
         .IgnoreCase = True
         .Pattern = "\:\s*[А-Я]{5,7}"
          t1 = Mid$(.Execute(st)(0).Value, 2)
          t2 = Mid$(.Execute(st)(1).Value, 2)
          t3 = Mid$(.Execute(st)(2).Value, 2)
       End With
      aaa = t1 & "," & t2 & "," & t3
End Function

Sub Macros()
Dim i As Long
Dim iStr1 As String, iStr2 As String
Dim Number As String, Text As String
For i = 7 To Cells(7, 4).End(xlDown).Row
   With CreateObject("vbscript.regexp")
     .Global = True
     .Pattern = "\s*[0-9]{2,3},"
      Number = Replace(Mid(.Execute(Cells(i, 4))(1).Value, 2), ",", "")
      .IgnoreCase = True
      .Pattern = "\s[À-ß-\+\s/¨]{4,50}$"
      Text = Mid(.Execute(Cells(i, 4))(0).Value, 2)
   End With
   If InStr(iStr1, Number) = 0 Then iStr1 = iStr1 & ", " & Number
   If InStr(iStr2, Text) = 0 Then iStr2 = iStr2 & ", " & Text
If Left(Cells(i, 4), 8) <> Left(Cells(i + 1, 4), 8) Then
Cells(i, 4).Offset(0, 1) = Mid(iStr1, 3)
Cells(i, 4).Offset(0, 2) = Mid(iStr2, 3)
iStr1 = "": iStr2 = ""
End If
Next i
End Sub