Saberexcel - o site de quem precisa aprender macros microsoft excel vba

Essas Funções do Aplicativo Microsoft Excel VBA, retornam um endereço de e-mail, observem que as funções personalizadas buscam por determinado caracter em algum lugar em uma frase, note que na primeira função busca o caracter (- ) ifem, quanto no segundo exemplo de função busca pelo caracter (@) Arroba. Os exemplos abaixo são muito úteis para quem lida com muitos nomes de emails que talvez estejam em meio a determinadas frases:
Espero que os exemplos de Função possam lhes ser útil. Fique com Deus, Expedito Marcondes

Essa função extrai uma determinada palavra de uma frase baseado em algum caracteres especificado no Macro por exemplo a frase:
CELULA (J2) = "Aprenda Microsoft excel vba, sozinho, praticando com os produtos didáticos saberexcel - [email protected] - "
Observe que nesta frase a função irá buscar o Caracter ( - ) traço (ifem)), e retornará o email. [email protected]
'- - - - - - - - - - - - - - - - - - - - - - - - - - - - - -'
Function ExtrairElementos(Texto, n, Separator) As String
ExtrairElementos = Split(Application.Trim(Texto), Separator)(n - 1)
End Function

USO CORRETO DA FUNÇÃO:
=ExtrairElementos(J2;2;"-")



OUTRA FUNÇÃO FUNÇÃO EXTRAI TEXTOS(EMAILS) DEPENDENDO DO CARACTER ESCOLHIDO.
'- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Observe bem, se voce tem uma frase como esta (apenas exemplo), a função ira busca pelo caracter '@' e retornará o endereço de email contido na frase. (muito útil para quem trabalha com muitos emails)
'- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
USO CORRETO DA FUNÇÃO:
Celula D7 = 'Aprenda macros, fórmulas e funções [email protected], produtos didáticos saberexcel'
Fórmula usada: SE(D7="";"";SE( ExtrairENDERECOEMAIL(D7)="";"NÃO HÁ EMAILS"; ExtrairENDERECOEMAIL(D7)))
veja que que a função tem duas condições, porém poderá usar somente uma:
'=ExtrairENDERECOEMAIL(D7).
'- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Function ExtrairENDERECOEMAIL(s As String) As String
Dim LocalizacaoARROBA As Long
Dim vCONTADOR As Long
Dim textoTEMP As String
Const listaCARACTER As String = "[A-Za-z0-9._-]"

'Obtendo a localização do caracter '@' arroba
LocalizacaoARROBA = InStr(s, "@")
If LocalizacaoARROBA = 0 Then
ExtrairENDERECOEMAIL = "" 'not found
Else
textoTEMP = ""

'Obtendo o primeiro endereço de email
For vCONTADOR = LocalizacaoARROBA - 1 To 1 Step -1
If Mid(s, vCONTADOR, 1) Like listaCARACTER Then
textoTEMP = Mid(s, vCONTADOR, 1) & textoTEMP
Else
Exit For
End If
Next vCONTADOR
If textoTEMP = "" Then Exit Function

'obtendo o segundo endereco de email
textoTEMP = textoTEMP & "@"
For vCONTADOR = LocalizacaoARROBA + 1 To Len(s)
If Mid(s, vCONTADOR, 1) Like listaCARACTER Then
textoTEMP = textoTEMP & Mid(s, vCONTADOR, 1)
Else
Exit For
End If
Next vCONTADOR

End If

'Remover ponto a direita se por ventura existir

If Right(textoTEMP, 1) = "." Then textoTEMP = _
Left(textoTEMP, Len(textoTEMP) - 1)
ExtrairENDERECOEMAIL = textoTEMP
End Function



Aprenda tudo sobre planilhas do Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Escola Saberexcel VBA Estudos® - Treinamentos com Macros, Fórmulas e Funções. http://www.microsoftexcel.com.br
e saberexcel.com