Ordenar filas de números con Word

Pruebe la siguiente Macro (Office 2007).

Sub PRUEBASORT444()                  

‘Declaración de variables

Dim rng As Range

Dim matWords() As String

Dim cadena As String, cadRep As String, mm As String

Dim i As Integer, j As Integer, k As Integer, y As Integer, z As Integer

z = ActiveDocument.Paragraphs.Count

For j = 1 To z

Set rng = ActiveDocument.Paragraphs(j).Range

' FILTRO si el primer caracter no es un número salta el ciclo al siguiente valor de j

If Asc(rng.Characters(1)) >= 48 And Asc(rng.Characters(1)) <= 57 Then

cadena = rng.Text                  ' P1 = 19-01-40-48-47-18-

  ' Quitar vbCr en cadena si lo hubiera

   If InStr(cadena, vbCr) <> 0 Then

   cadena = Trim(Left(cadena, InStr(cadena, vbCr) - 1))

   End If

cadRep = Replace(cadena, "-", " ")

rng.Text = cadRep & vbCr   ' ahora P1 = 19 01 40 48 47 18

Set rng = ActiveDocument.Paragraphs(j).Range

y = rng.Words.Count

Debug.Print "nº de Words = " & y

 Debug.Print "cadena = " & cadena

Debug.Print "cadRep = " & cadRep

For i = 1 To y - 1

ReDim Preserve matWords(1 To (y - 1))

matWords(i) = RTrim(rng.Words(i))

Debug.Print " Words = " & i & " " & rng.Words(i)

Next

WordBasic.SortArray matWords() ' ORDENAR

‘ Poner guión al final de cada párrafo

ReDim Preserve matWords(1 To y)

matWords(y) = " "

           For k = 1 To y

Debug.Print " matWords = " & k & " " & matWords(k)

Next

mm = Join(matWords, "-")     

rng.Text = mm & vbCr                       ‘ sustituye el texto original

Erase matWords       ‘ limpia la matriz de cada párrafo

End If

Next j

End Sub

ORIGINAL

29-01-12-49-47-02-

21-06-34-29-07-09-

19-03-40-37-43-18-

RESULTADO

01-02-12-29-47-49-

05-06-21-34-47-49-

03-18-18-19-40-47-