Sub DemoOrigDoc()
    Dim oOrigDoc As Document
    Dim oPara As Paragraph
    Dim rngWorking As Range
    Dim aryTemp() As String
    Dim i As Integer
    Dim sNewText As String
     
     'set our original document
    Set oOrigDoc = ActiveDocument
     
    oOrigDoc.Content.Cut
    oOrigDoc.Content.Paste
     
     'some quick and dirty formatting for readability
    With oOrigDoc.Content
        .Font.Name = "Arial"
        .Font.Size = 12
        .ParagraphFormat.SpaceAfter = 0
        .ParagraphFormat.SpaceBefore = 0
    End With
     
     
     'go through all our paragraphs
    For Each oPara In oOrigDoc.Paragraphs
         'skip any paragraphs which are empty
        If Len(oPara.Range) > 1 Then
             'initialize the range as the entire paragraph
            Set rngWorking = oPara.Range
             'move the beginning to the line of text after the soft return
            rngWorking.Start = rngWorking.Start + InStr(rngWorking.Text, Chr(11))
             'and move the end back from the paragraph mark
            rngWorking.MoveEnd wdCharacter, -1
             
             'for stepping through-- can remove later
            rngWorking.Select
             
             'get an array of our phrases
            aryTemp = Split(rngWorking.Text, "/")
             'and transform each one
            For i = 0 To UBound(aryTemp)
                aryTemp(i) = fTransformText(aryTemp(i))
            Next
             
             'reset our new text variable
            sNewText = ""
             'and rebuild our new text string
            For i = 0 To UBound(aryTemp)
                sNewText = sNewText & aryTemp(i)
                If i < UBound(aryTemp) Then
                    sNewText = sNewText & "/"
                End If
            Next
             'append the text for now, separated by a soft-return
             'for easier comparison if the tranformation is working correctly
            rngWorking.Text = sNewText
        End If
    Next
End Sub
 'transform passed in text
 'return original text prepended by ERROR: if there is an issue with the text
Public Function fTransformText(sWhatText As String) As String
    Dim sOrigText As String
    Dim sLeft As String
    Dim aryLeft() As String
    Dim sRight As String
    Dim aryRight() As String
    Dim i As Integer
    Dim x As Integer
    Dim sReturn As String
    Dim sTemp As String
    Dim sTemp2 As String
     
    sOrigText = sWhatText
    On Error GoTo l_err
    sLeft = Left(sOrigText, InStr(sOrigText, "x") - 1)
    sRight = Right(sOrigText, Len(sOrigText) - InStr(sOrigText, "x"))
    aryRight = Split(sRight, ".")
    aryLeft = Split(sLeft, ".")
     
    For i = LBound(aryRight) To UBound(aryRight)
         'put in a divider line
        If sReturn <> "" Then
            sTemp = "/"
        End If
         'truncate as many digits off as needed
        If UBound(aryLeft) > 0 Then
            For x = LBound(aryLeft) To UBound(aryLeft)
                If Len(sTemp) > 1 Then
                    sTemp = sTemp & "."
                End If
                sTemp = sTemp & Mid(aryLeft(x), i + 1, Len(aryLeft(x)) - i)
            Next
        Else
            sTemp = sTemp & Mid(sLeft, i + 1, Len(sLeft) - i)
        End If
        sTemp = sTemp & "x" & aryRight(i)
        sReturn = sReturn & sTemp
    Next
     
l_exit:
    fTransformText = sReturn
    Exit Function
l_err:
    sReturn = "ERROR: " & sOrigText
    Resume l_exit
End Function

https://www.msofficeforums.com/word-vba/14116-separate-digits-into-3-combinations.html#post38985