Excel Executar macro quando o conteúdo da célula é alterado por fórmula

[Maxfdias]

Boa noite a todos.

Não entendo muito de VBA então estou precisando muito de uma ajudinha aqui dos feras em Excel!

 

Tenho uma rotina que automatiza o preenchimento de um grupo célula quando uma destas sofrem alguma alteração, neste caso toda vez que a coluna AD30 a partir da linha 10  sofre uma alteração a rotina preenche a coluna correspondente neste caso AE31, com uma (fórmula) caso ela fique vazia esta fórmula é apagada... A rotina funciona bem mais o meu problema é que eu tenho que alterar a célula para ativa-la, preciso de ajuda para adaptar este mesmo código para um “Evento” que possibilite verificar se o conjunto de células da coluna AD foram modificadas por uma fórmula ou filtro avançado. Espero ter explicado de forma clara.

A código que estou usando está abaixo! Conto com a ajuda de vcs.

 

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim COLUNA As Double
Dim LINHA As Double

COLUNA = Target.Column
LINHA = Target.Row

 

'Se A coluna for igual a 30 ou (AD) e a linha maior ou igual a 10. Então
If COLUNA = 30 And LINHA >= 10 Then
    'Verificar se a cécula do Ôdometro está Vazia
    If Range(Target.Address) = "" Then
    'Limpar a célula (KM RODADO)se a céclula Ôdometro estiver vazia
    Cells(LINHA, 31) = ""
    'SE não estiver vazia e célula (KM RODADO)estiver vazia
    ElseIf Cells(LINHA, 31) = "" Then
    'Adicionar fórmula para calculo de (KM RODADO)
    Cells(LINHA, 31).FormulaArray = "=IFERROR(RC[-1]-INDIRECT(""AD""&LARGE(IF(R10C24:RC[-7]=RC[-7],ROW(R10C24:RC[-7])),2)),""0"")"

        
    End If
  End If

End Sub

 

Planilha:

 

 

 

[AfonsoMira]

Boas, tudo bem.

Como exatamente os valores de AD atualizam? Um por um , todos de uma vez ou aleatóriamente?

 

Obrigado!

[Maxfdias]

@AfonsoMira Olá,Afonso. Tudo certo!

 

A planilha funciona da seguinte forma, como pode observar no print que anexei ao post, as colunas de V:AD atualizam por meio de um "filtro avançado" ao identificar que a coluna AD foi alterada a rotina preenche a coluna AE com uma fórmula. O meu problema está no "evento" pois para que o código em questão seja acionado deve haver uma alteração na célula... Mais o que preciso na verdade e que o código seja acionado quando o conteúdo for modificado...

 

Desde já agradeço sua interação! Preciso muito desta solução. 

[AfonsoMira]

@Maxfdias Boas veja se com este código consegue. 

Private Sub Worksheet_Change(ByVal Target As Range)

Dim ultimaLinha As Long

ultimaLinha = ActiveSheet.Cells(Rows.Count, 30).End(xlUp).Row

Application.EnableEvents = False
Application.ScreenUpdating = False

For i = 10 To ultimaLinha
    'Verificar se a cécula do Ôdometro está Vazia
    If Cells(i, 30) = "" Then
        'Limpar a célula (KM RODADO)se a céclula Ôdometro etiver vazia
        Cells(i, 31) = ""
    Else
        'Adicionar fórmula para calculo de (KM RODADO)
        Cells(i, 31).FormulaArray = "=IFERROR(RC[-1]-INDIRECT(""AD""&LARGE(IF(R10C24:RC[-7]=RC[-7],ROW(R10C24:RC[-7])),2)),""0"")"
    End If
Next i

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

 

[Maxfdias]

@AfonsoMira Esta aplicando a formulá muito bem! O único problema e que não está "limpando" quando a coluna AD está vazia! Se puder dar uma olhada nisso para mim.... de qualquer forma me ajudou muito... Sou muito grato! 

[AfonsoMira]

@Maxfdias Ora experimente desta forma:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim ultimaLinha As Long

ultimaLinha = ActiveSheet.Cells(Rows.Count, 29).End(xlUp).Row

Application.EnableEvents = False
Application.ScreenUpdating = False

For i = 10 To ultimaLinha
    'Verificar se a cécula do Ôdometro está Vazia
    If Cells(i, 30) = "" Then
        'Limpar a célula (KM RODADO)se a céclula Ôdometro etiver vazia
        Cells(i, 31) = ""
    Else
        'Adicionar fórmula para calculo de (KM RODADO)
        Cells(i, 31).FormulaArray = "=IFERROR(RC[-1]-INDIRECT(""AD""&LARGE(IF(R10C24:RC[-7]=RC[-7],ROW(R10C24:RC[-7])),2)),""0"")"
    End If
Next i

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Caso continue sem funcionar, utilize antes este código:

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False
Application.ScreenUpdating = False

For i = 10 To 500
    'Verificar se a cécula do Ôdometro está Vazia
    If Cells(i, 30) = "" Then
        'Limpar a célula (KM RODADO)se a céclula Ôdometro etiver vazia
        Cells(i, 31) = ""
    Else
        'Adicionar fórmula para calculo de (KM RODADO)
        Cells(i, 31).FormulaArray = "=IFERROR(RC[-1]-INDIRECT(""AD""&LARGE(IF(R10C24:RC[-7]=RC[-7],ROW(R10C24:RC[-7])),2)),""0"")"
    End If
Next i

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

 

[Maxfdias]

1 hora atrás, AfonsoMira disse:

@Maxfdias Ora experimente desta forma:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim ultimaLinha As Long

ultimaLinha = ActiveSheet.Cells(Rows.Count, 29).End(xlUp).Row

Application.EnableEvents = False
Application.ScreenUpdating = False

For i = 10 To ultimaLinha
    'Verificar se a cécula do Ôdometro está Vazia
    If Cells(i, 30) = "" Then
        'Limpar a célula (KM RODADO)se a céclula Ôdometro etiver vazia
        Cells(i, 31) = ""
    Else
        'Adicionar fórmula para calculo de (KM RODADO)
        Cells(i, 31).FormulaArray = "=IFERROR(RC[-1]-INDIRECT(""AD""&LARGE(IF(R10C24:RC[-7]=RC[-7],ROW(R10C24:RC[-7])),2)),""0"")"
    End If
Next i

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Caso continue sem funcionar, utilize antes este código:

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False
Application.ScreenUpdating = False

For i = 10 To 500
    'Verificar se a cécula do Ôdometro está Vazia
    If Cells(i, 30) = "" Then
        'Limpar a célula (KM RODADO)se a céclula Ôdometro etiver vazia
        Cells(i, 31) = ""
    Else
        'Adicionar fórmula para calculo de (KM RODADO)
        Cells(i, 31).FormulaArray = "=IFERROR(RC[-1]-INDIRECT(""AD""&LARGE(IF(R10C24:RC[-7]=RC[-7],ROW(R10C24:RC[-7])),2)),""0"")"
    End If
Next i

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

 

Afonso, o segundo código que você postou está funcionando mais tem alguma inconsistência, ha momentos em que ele funciona ou seja limpa a célula e algumas vezes em que ele simplesmente não insere a fórmula! 

[AfonsoMira]

Pode disponibilizar a planilha para eu poder testar nela?

Obrigado!

[Maxfdias]

@AfonsoMira Eu coloquei a planilha em anexo, ela ainda esta em construção então os dados estão em uma parte e os controles em outra, tem um botão que aplica o filtro avançado... Por favor, verifique o que esta ocorrendo!

Gestão de Frota 2.1 - Cópia.rar

[AfonsoMira]

@Maxfdias Obrigado, por disponibilizar o ficheiro.

Estive a ver o seu ficheiro e decidi retirar o código no evento change e adicionalo ao botão de pesquisa que utiliza para efetuar o filtro.

Veja se é este o resultado que espera.

Gestão de Frota 2.1 - Afonso Mira.xlsm.zip

[Maxfdias]

@AfonsoMira Excelente, o resultado que esperava era exatamente este. Funciona muito bem! Muito obrigado pela ajuda Afonso.

[AfonsoMira]

@Maxfdias Ora essa foi um prazer ajudar.

Não se esqueça de curtir a resposta como forma de agradecimento .

Obrigado!