Função Super Trim

Na programação em geral, o termo TRIM refere-se à algoritmos para remoção de espaços extras contidos em um texto, ou seja, é uma espécie de faxina, que limpa alguns excessos.

Pensando nisso, fui além e elaborei uma função um pouco mais complexa, que realiza uma varredura não só nas bordas do texto, como também em seu interior.

Exemplo:

Texto antigo:
"Teste    de   limpeza de     espaços .  "
Após a aplicação da função que elaborei, teremos o seguinte resultado:
"Teste de limpeza de espaços."

Elaborei duas funções, sendo a SUPERTRIM a mais complexa, e a SUPERTRIMS a mais simples, porém com o mesmo resultado.

Se na célula A1 tivermos o seguinte texto:
"Só    estou    testando.  "
A função SUPERTRIM funcionará da seguinte maneira:
=SUPERTRIM( célula ou "texto" ; "texto a ser substituido" ; "pelo texto")
=SUPERTRIM(A1;"  ";" ")
Resultado: "Só estou testando."

Um outro exemplo seria o seguinte:
Ainda na célula A1, temos o seguinte texto:
"Só|estou||||||testando||||esta|função."
=SUPERTRIM( célula ou "texto" ; "texto a ser substituido" ; "pelo texto")
=SUPERTRIM(A1;"||";"|")
Resultado: "Só|estou|testando|esta|função."
Ou seja, a função SUPERTRIM não se limita somente a caracteres de espaços, podendo ela ser personalizada de acordo com cada necessidade.

Por outro lado, a função SUPERTRIMS é bem mais objetiva, porém seu alvo é especificamente o caractere de espaço.

Se na célula A1 tivermos o seguinte texto:
"Só        estou      testando.     "
A função SUPERTRIMS funcionará da seguinte maneria:
=SUPERTRIMS( célula ou "texto" )
=SUPERTRIMS(A1)
Resultado: "Só estou testando."

Segue funções:

Public Function SUPERTRIM(ByRef texto As String, ByRef caractere As String, ByRef newcaractere As String) As String
Dim textok(5000) As String
If caractere = "" Then
caractere = "  "
Else: End If
If newcaractere = "" Then
newcaractere = " "
Else: End If
textok(1) = texto
On Error GoTo endy
For i = 2 To 5000
textok(i) = WorksheetFunction.Substitute(textok(i - 1), caractere, newcaractere)
Next
endy:
SUPERTRIM = textok(i - 1)
End Function

Public Function SUPERTRIMS(ByRef texto As String) As String
Dim textok(5000) As String
caractere = "  "
newcaractere = " "
textok(1) = texto
On Error GoTo endy
For i = 2 To 5000
textok(i) = WorksheetFunction.Substitute(textok(i - 1), caractere, newcaractere)
Next
endy:
SUPERTRIMS = textok(i - 1)
End Function

É isso!