Notifications
Clear all

Separar fones fixos de móveis para acrescentar nono dígito

6 Posts
4 Usuários
0 Reactions
1,103 Visualizações
(@lorddantas)
Posts: 0
New Member
Topic starter
 

Olá a todos, estou com um problema, tenho esse script para inserir o nono dígito se o telefone iniciar com 6,7,8,9..

Function ValidarCelular(Myrange As Range) As String
    On Error GoTo ErrHandler:
    Dim regEx As New RegExp
    Dim strPattern As String
    Dim strInput As String
    Dim strReplace As String
    Dim strOutput As String

    strPattern = "^[6|7|8|9](?:d{7}|d{3}-d{4})$"

    If strPattern <> "" Then
        strInput = Trim(Myrange.Value)
        strReplace = "9" & strInput

        With regEx
            .Global = True
            .MultiLine = True
            .IgnoreCase = False
            .Pattern = strPattern
        End With
            If regEx.test(strInput) Then
                ValidarCelular = regEx.Replace(strInput, strReplace)
            Else
                ValidarCelular = Myrange.Value
            End If
    End If
Exit Function
ErrHandler:
    ' Tratamento de Erro
    ValidarCelular= CVErr(xlErrNA)
    On Error GoTo 0
End Function

Porém eu preciso que a função pule os dois primeiros dígitos (o DDD) e faça a verificação do número a partir do terceiro dígito, alguém sabe como fazer isso?

 
Postado : 04/05/2018 9:13 am
(@wagner-morel-vidal-nobre)
Posts: 4063
Famed Member
 

lorddantas,

Boa tarde!

Seja muito bem vindo ao fórum.

Para aproveitar ao máximo o fórum e sempre manter o mesmo de forma organizada, sugiro ler os tópico da regras abaixo:
viewtopic.php?f=7&t=16757
viewtopic.php?f=7&t=203
viewtopic.php?f=7&t=7903
viewtopic.php?f=7&t=3841
viewtopic.php?f=7&t=12600
viewtopic.php?f=7&t=3371

Algumas solicitações especiais que pedimos, por gentileza, ficar atento:
1 - Não inserir no titulo de suas postagens expressões como Help, Ajuda, etc. O título deve ser um resumo da sua necessidade para que outras pessoas que tenham a mesma dúvida possam efetuar a pesquisa e achar como foi resolvido.
2 - Não insira em suas mensagens frases todas escritas em letras maiúsculas. Isso, na Internet, é compreendido como gritos e muitos usuários sequer respondem somente por esse fato!
3 - Insira sempre um arquivo exemplo compactado com .ZIP aqui mesmo no fórum. Existe, logo abaixo da caixa de mensagens, uma aba chamada "Adicionar um anexo" para essa finalidade.
4 - Não utilize a ferramenta CITAR para inserir o inteiro teor das mensagens que lhe são encaminhadas como resposta. Citações, se estritamente necessárias ao entendimento da mensagem que você quer enviar, devem ser apenas de pequenos trechos das mensagens.
5 - Se for postar códigos VBA aqui no fórum, utilize a ferramenta CODE localizada logo no início da caixa de mensagens (quinto botão da esquerda para a direita). As linhas de código devem ficar entre as palavras "CODE e /CODE".
6 - Agradeça sempre às pessoas que lhe responderam e às mensagens que atenderam a necessidade de sua demanda. Esse agradecimento deve ser clicando na mãozinha que fica localizada ao lado da ferramenta CITAR. Lembre-se: o fórum é gratuito e esse é o único incentivo para as pessoas que prestam ajuda. Você pode agradecer a quantos usuários quiser.

 
Postado : 04/05/2018 9:26 am
(@xlarruda)
Posts: 0
New Member
 

Poste uma planilha de exemplo por favor...

 
Postado : 04/05/2018 10:20 am
(@wagner-morel-vidal-nobre)
Posts: 4063
Famed Member
 

lorddantas,

Veja se é assim.

 
Postado : 04/05/2018 10:52 am
(@lorddantas)
Posts: 0
New Member
Topic starter
 

Exatamente vagner!, muito obrigado!

 
Postado : 04/05/2018 11:29 am
(@edsonbr)
Posts: 0
New Member
 

Bem vindo, LordDantas!

Só pra não perder a viajem (e o trabalho que fiz), já que enquanto eu tava alterando o código o Wagner foi mais rápido que um raio!!! rsrsrsrsr

Alterei e corrigi o pattern do Regex (havia um erro) para incluir a especificação do código de área, inclusive com um 0 na frente se tiver.

Function ValidarCelular(Myrange As Range) As String
    On Error GoTo ErrHandler:
    Dim regEx As New RegExp
    Dim strInput As String
    strInput = Trim(Myrange.Value)
    With regEx
      .Global = True
      .MultiLine = True
      .Pattern = "^(0?(?:d{2})?)(9?)([6-9]d{3})-?(d{4})$"
      If .test(strInput) Then
         With .Execute(strInput)(0).SubMatches
             ValidarCelular = .Item(0) & "9" & .Item(2) & .Item(3)
         End With
      Else
          ValidarCelular = Myrange.Value
      End If
    End With
    Set regEx = Nothing
Exit Function
ErrHandler:
    'Tratamento de Erro
    ValidarCelular = CVErr(xlErrNA)
    On Error GoTo 0
End Function
 
Postado : 04/05/2018 11:47 am