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!

Função para Contar Caracteres Específicos no Texto de uma Célula

Outro dia surgiu a necessidade de contar quantos caracteres "@" (arroba) haviam no texto de uma célula.

Por exemplo, a célula A1 continha o texto: "meu@nome@é@esse@fim"

A fórmula retornaria o seguinte valor: 4, pois essa é a quantidade exata de @ dentro da célula.

Num outro caso, precisei contar quantos fragmentos de texto, como por exemplo, "meu_nome" haviam no texto de uma célula.

O texto era: "Aqui_entra_meu_nome_e_aqui_meu_nome_sai."

O resultado da função nesse caso seria: 2, pois o texto contém "meu_nome" duas vezes.

Se o texto que você quer está na célula A1, sua função precisará inserida em outra célula da seguinte forma:

Funcionamento: =CONTCAR( "defina aqui a célula ou algum texto" ; "defina aqui o que será procurado")

=CONTCAR(A1;"|")

Se a célula A1 aqui contiver o texto: "Meu|Número|é|123456", o resultado seria: 3, pois estaríamos procurando pela quantidade de caracteres "|" (pipe) no texto.


Segue função:

Public Function CONTCAR(ByRef Texto As String, ByVal Caractere As String) As Integer

Dim tamanho, tmn, total As Variant
total = 0
tamanho = Len(Texto)
tmn = Len(Caractere)
    For i = 1 To tamanho
 
        If Mid(Texto, i, tmn) = Caractere Then
     
            total = total + 1
     
        Else: End If
    Next
CONTCAR = total

End Function

Fim!

Função para lidar com Nomes de Arquivos

Segue aqui três funções que precisei criar em uma ocasião.

Elas servem para lidar com nomes de arquivos, exatamente como no exemplo a seguir:

A célula A1 contém o seguinte texto: C:\Pasta1\Subpasta1\ArquivoTeste.txt

Nesse caso, cada função irá retornar um resultado diferente, baseado no exemplo anterior.
A seguir, demonstro o resultado de cada função, caso estas sejam inseridas da seguinte forma em outras células:

=FILENAME(A1) resultaria em: ArquivoTeste

=FILEXT(A1) resultaria em: .txt  

=FILEDIR(A1) resultaria em: C:\Pasta1\Subpasta1\

Segue agora as funções para serem inseridas em um módulo VBA, através do "Alt + F11":

Public Function FILENAME(ByVal flname As String) As String

Dim FILEX As String

FILEX = StrReverse(Mid(StrReverse(flname), 1, WorksheetFunction.Find("\", StrReverse(flname), 1) - 1))

FILENAME = StrReverse(Mid(StrReverse(FILEX), WorksheetFunction.Find(".", StrReverse(FILEX), 1) + 1, 500))

End Function

Public Function FILEXT(ByVal flname As String) As String

Dim FILEX As String

FILEX = StrReverse(Mid(StrReverse(flname), 1, WorksheetFunction.Find("\", StrReverse(flname), 1) - 1))

FILEXT = StrReverse(Mid(StrReverse(FILEX), 1, WorksheetFunction.Find(".", StrReverse(FILEX), 1)))

End Function

Public Function FILEDIR(ByVal flname As String) As String

Dim FILEX As String

FILEDIR = StrReverse(Mid(StrReverse(flname), WorksheetFunction.Find("\", StrReverse(flname), 1), 500))

End Function

É isso!