Macro para passar os numeros da direita para esquerda

[Squarcini]

Fala Pessoal, tudo bem?
Tenho um desafio, suponha o seguinte texto em uma celula:
" TEXT TEXT S.A 12- 3 "
preciso passar os números que estão na direita para a esquerda ficando da seguinte forma:
"12- 3 TEXT TEXT S.A "
Pesquisei alguns códigos no chatgpt e o que consegui de resultado foi :
" . 12-3TEXTTEXTSA "
O que acontece :
Os caracteres especiais que estão a esquerda do numero permanece pois muitas vezes ele vem por que está entre os textos e não entre os números.
No caso preciso que somente os caracteres entre os números permaneçam e se for possível os entre os textos.
A questão é que na macro ele percorre todo o conteudo da celula e identifica os numeros e os caracteres, assim peço para ele não começar com caracteres a esquerda, porém a macro intende que deve se excluir os caracteres entre os textos (pois eles estão a esquerda dos numeros), mas em alguns momentos ele retorna com os caracteres no começo pois são os que estão entre os textos.
Depois ao final da Macro ele concatena com o texto porém ele não respeita os espaços entre os textos e o próprio número.
Precisava de alguma macro ou formula mesmo.
No Excel isso é um pouco mais fácil devido ao preenchimento relâmpago.
Tenho textos da seguinte forma:
USINA ALTO ALEGRE S/A - ACUCAR 16105
retorna: - 16105 USINAALTOALEGRES/AACUCAR
DORI ALIMENTOS S-A 16045
retorna: - 16045 DORIALIMENTOSSA
USINA ALTO ALEGRE S.A - ACUCAR 16068
retorna: - 16068 USINAALTOALEGRES.AACUCAR
AUTO ADES. PARANA S.A 16102
retorna: 16102 AUTOADES.PARANAS.A

Desde já agradeço

[schiavinatto]

Ola @Squarcini , todos os númeos do final do texto, tem 5 dígitos?

[Squarcini]

ALTERAR_HISTORICO_RECEBIMENTOS_ITAU_17308134374697803.xls (30,KB)
@schiavinatto hum acredito que nem em todos os momentos vai haver esse padrão.
Deixei a planilha acima para estudo de caso…

[schiavinatto]

' FONTE: https://www.youtube.com/watch?v=vgtugfuVEV8 
Function ExtrairNumero(CellRef As String)
Dim StringLength As Integer
StringLength = Len(CellRef)
For i = 1 To StringLength
If IsNumeric(Mid(CellRef, i,1)) Then Result = Result & Mid(CellRef, i, 1)
Next i
ExtrairNumero = Result
End Function

ALTERAR_HISTORICO_RECEBIMENTOS_ITAU_17308134374697803_GS.xls (42,KB)

[Squarcini]

Olá!
Agradeço a Lembrança!

De fato a macro apontada Startou uma nova maneira de escrever o Script, no entanto o comportamento no LibreOffice é um tanto diferente quanto ao Excel Microsoft e o mesmo não me atenderia.

Sendo assim decidi utilizar o DeepSeek e obtive uma Macro Melhor com apenas um pequeno detalhe que não consegui resolver mas que acredito ter chegado a onde queria. Deixo ela abaixo :
Sub ReorganizarTexto()
Dim oSheet As Object
Dim oCell As Object
Dim oRange As Object
Dim oSelection As Object
Dim i As Integer
Dim sTexto As String
Dim sNome As String
Dim sNumero As String
Dim aPartes() As String
Dim sResultado As String

' Obtém a planilha ativa
oSheet = ThisComponent.CurrentController.ActiveSheet

' Obtém a seleção atual do usuário
oSelection = ThisComponent.CurrentSelection

' Verifica se a seleção é um intervalo de células
If Not oSelection.supportsService("com.sun.star.sheet.SheetCellRange") Then
    MsgBox "Por favor, selecione um intervalo de células antes de executar a macro.", 16, "Erro"
    Exit Sub
End If

' Converte a seleção para um intervalo de células
oRange = oSelection

' Percorre cada célula no intervalo selecionado
For i = 0 To oRange.getRows().getCount() - 1
    oCell = oRange.getCellByPosition(0, i)
    sTexto = oCell.getString()
    
    ' Divide o texto em partes (nome e número)
    aPartes = Split(sTexto, " ")
    sNome = ""
    sNumero = ""
    
    ' Percorre as partes para separar nome e número
    Dim j As Integer
    For j = LBound(aPartes) To UBound(aPartes)
        If IsNumeric(Left(aPartes(j), 1)) Then
            sNumero = sNumero & " " & aPartes(j)
        Else
            sNome = sNome & " " & aPartes(j)
        End If
    Next j
    
    ' Remove espaços em branco extras
    sNome = Trim(sNome)
    sNumero = Trim(sNumero)
    
    ' Reorganiza o texto
    sResultado = sNumero & " " & sNome
    
    ' Escreve o resultado na célula ao lado (coluna B)
    oSheet.getCellByPosition(oCell.RangeAddress.StartColumn + 1, oCell.RangeAddress.StartRow).setString(sResultado)
Next i

MsgBox "Reorganização concluída!"

End Sub

Para mim situação Resolvida, Grato a todos aqui!