Private Sub Worksheet_Change quando somente alterar uma cell

2024 - VBA & Macros

Post Recente por Fabiano 8 anos atrás

3 Posts

2 Usuários

0 Reactions

1,001 Visualizações

RSS

Fabiano

(@alanisfcsm)

Posts: 0

Trusted Member

Topic starter

Olá!

Fiz algumas alterações nesse código que copie da net, ele funciona do jeito que preciso, mas ele roda sempre que altero qualquer celula.

Seria possível rodar o código somente quando "M8" for alterado?

:oops:


Private Sub Worksheet_Change(ByVal Target As Excel.Range)
   
    Range("Q3").Select
    Selection.Copy
    Range("S3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    

Dim Dig, Nvar
'NVar = Format(Range("S3"), "00000000000000")
If Target.Address = Range("S3").Address Then
        If IsNumeric(Range("S3")) Then  'se não preencher o campo ignora
        Dig = Right(Format(Range("S3"), "00000000000000"), 2)
        Nvar = Módulo1.DVCNPJ(Format(Range("S3"), "00000000000000"))
        If Dig = Nvar Then
        'Else 'senão avisa em vermelho
        'Range("S3") = "CNPJ INVÁLIDO"
        Range("S3").Interior.Color = RGB(255, 255, 255)
        Range("M8").Interior.Color = RGB(255, 255, 255)
        Else
        Range("S3").Interior.Color = RGB(255, 0, 0)
        Range("M8").Interior.Color = RGB(255, 0, 0)
        End If
        End If
ElseIf Target.Address = Range("B15").Address Then
        If IsNumeric(Range("B15")) Then  'se não preencher o campo ignora
        Dig = Right(Format(Range("B15"), "00000000000"), 2)
        Nvar = Módulo1.DVCPF(Format(Range("B15"), "00000000000"))
        If Dig = Nvar Then
        Else 'senão avisa em vermelho
        Range("B15") = "CPF INVÁLIDO"
        End If
        End If
ElseIf Target.Address = Range("B18").Address Then
        If IsNumeric(Range("B18")) Then  'se não preencher o campo ignora
        Dig = Right(Format(Range("B18"), "00000000000"), 1)
        Nvar = Módulo1.PISPASEP(Format(Range("B18"), "00000000000"))
        If Módulo1.PISPASEP(Format(Range("B18"), "00000000000")) = True Then
        Else 'senão avisa em vermelho
        Range("B18") = "PIS/PASEP INVÁLIDO"
        End If
        End If

End If
End Sub

Postado : 30/09/2016 6:22 am

Fernando Fernandes

(@fernandofernandes)

Posts: 43750

Illustrious Member

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Address = Range("M8").Address Then
       
        Range("Q3").Select
        Selection.Copy
        Range("S3").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
       
    Dim Dig, Nvar
        'NVar = Format(Range("S3"), "00000000000000")
        If Target.Address = Range("S3").Address Then
                If IsNumeric(Range("S3")) Then  'se não preencher o campo ignora
                Dig = Right(Format(Range("S3"), "00000000000000"), 2)
                Nvar = Módulo1.DVCNPJ(Format(Range("S3"), "00000000000000"))
                If Dig = Nvar Then
                'Else 'senão avisa em vermelho
                'Range("S3") = "CNPJ INVÁLIDO"
                Range("S3").Interior.Color = RGB(255, 255, 255)
                Range("M8").Interior.Color = RGB(255, 255, 255)
                Else
                Range("S3").Interior.Color = RGB(255, 0, 0)
                Range("M8").Interior.Color = RGB(255, 0, 0)
                End If
                End If
        ElseIf Target.Address = Range("B15").Address Then
                If IsNumeric(Range("B15")) Then  'se não preencher o campo ignora
                Dig = Right(Format(Range("B15"), "00000000000"), 2)
                Nvar = Módulo1.DVCPF(Format(Range("B15"), "00000000000"))
                If Dig = Nvar Then
                Else 'senão avisa em vermelho
                Range("B15") = "CPF INVÁLIDO"
                End If
                End If
        ElseIf Target.Address = Range("B18").Address Then
                If IsNumeric(Range("B18")) Then  'se não preencher o campo ignora
                Dig = Right(Format(Range("B18"), "00000000000"), 1)
                Nvar = Módulo1.PISPASEP(Format(Range("B18"), "00000000000"))
                If Módulo1.PISPASEP(Format(Range("B18"), "00000000000")) = True Then
                Else 'senão avisa em vermelho
                Range("B18") = "PIS/PASEP INVÁLIDO"
                End If
                End If
    
        End If
    End If
    
End Sub

[]s

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

Postado : 30/09/2016 7:06 am