Excel Código VBA pra atualizar coluna

[jcgmcs]

Bom dia!

Eu tinha essa formula =($D$1-Q5) &"" na coluna "P" a partir da linha 5 que me retornava a contagem de Dias. Com a ajuda de um amigo do Forum consegui este código abaixo:

 

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long
    
    Application.EnableEvents = False
    
    If Target.Count > 1 Then
        Application.EnableEvents = True
        Exit Sub
    End If
    
    If Target.Address(False, False) = "D1" Then
        For i = 5 To 3000
            Range("P" & i).Value = CDate(Range("D1").Value) - CDate(Range("Q" & i).Value)
        Next i
    ElseIf Target.Column = 17 And Target.Row > 4 Then
        Range("P" & Target.Row).Value = CDate(Range("D1").Value) - CDate(Range("Q" & Target.Row).Value)
    End If
    
    Application.EnableEvents = True
End Sub 

 

Funciona.. porém ocorre que quando mudo o dia na "D1" pra uma outra data qualquer, o processo de atualização na coluna "P" que atualmente tenho mais de 2.000 linhas, está muito demorado, em torno de 4min +/- pra atualizar a recontagem...

Será que teria uma maneira de deixar esse código de forma instantânea assim como ocorre com a formula =($D$1-Q5) &"" que mudando a data, instantâneamente é feito as atualizações em toda a coluna...??

obrigado..

Att, Carlos

[Visitante]

Experimente este.

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Count > 1 Then Exit Sub
  If Target.Address(False, False) = "D1" And Target.Value <> "" Then
   Range("P5:P" & Cells(Rows.Count, 17).End(3).Row) = "=D$1-Q5"
   Range("P5:P" & Cells(Rows.Count, 17).End(3).Row).Value = Range("P5:P" & Cells(Rows.Count, 17).End(3).Row).Value
  ElseIf Target.Column = 17 And Target.Row > 4 Then
   Range("P" & Target.Row).Value = Range("D1") - Range("Q" & Target.Row)
  End If
End Sub

Curiosidades:

1. qual a razão para você utilizar macro atualmente no lugar das fórmulas que utilizava antes?

2. qual a missão da parte em vermelho na sua fórmula ? ~~~> =($D$1-Q5) &""

[jcgmcs]

Osvaldo, boa tde amigo.. todo Bem!

você é o cara mesmo!! Funcionou perfeitamente, quase q instantâneo... Rss Porém, na coluna "Q" tenho muitas linhas sem datas, poluindo a coluna "P" com estes valores: "44041".. Queria eliminar isso.. E esta é minha razão de não usar a formula tdeu..

Qto ao que está: &"" tbém não sei dizer.. foi me passado uma ajuda dessa maneira, funcionou... e até então estava usando assim... Rsss

Obrigado amigo e aguardo a eliminação disso... valores: "44041"

 

[Visitante]

2 horas atrás, jcgmcs disse:

Porém, na coluna "Q" tenho muitas linhas sem datas, poluindo a coluna "P" com estes valores: "44041".. Queria eliminar isso..

Para eliminar instale uma cópia do código abaixo no lugar do anterior que passei.

Acrescentei também um comando para limpar P, se após rodar o código, Q for limpada.

 

E esta é minha razão de não usar a formula ...

Se você quiser testar com fórmula novamente, coloque uma cópia desta abaixo em P5 e estenda pela coluna até a linha que desejar ~~~> =SE(Q5="";"";D$1-Q5)

 

 

 

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Count > 1 Then Exit Sub
  If Target.Address(False, False) = "D1" And Target.Value <> "" Then
   Range("P5:P" & Cells(Rows.Count, 17).End(3).Row).Formula = "=IF(Q5="""","""",D$1-Q5)"
   Range("P5:P" & Cells(Rows.Count, 17).End(3).Row).Value = Range("P5:P" & Cells(Rows.Count, 17).End(3).Row).Value
  ElseIf Target.Column = 17 And Target.Row > 4 Then
   Range("P" & Target.Row).Value = IIf(Target.Value <> "", Range("D1") - Range("Q" & Target.Row), "")
  End If
End Sub

 

[jcgmcs]

Ficou perfeito meu amigo... Melhor q o anterior..!!!

Muito obrigado mesmo..!!

Por hora vou fazer uns testes na planilha original e vamos ver se vae rodar tudo certinho...

E a formula, agora é sim, de grande valia... Rss Parabéns pelo seu conhecimento..........

Abrç..

 

 

[jcgmcs]

Osvaldo, bom dia amigo..

Entao seguinte.. testei digitando informações manualmente nas linhas da planilha e funcionou direitinho, porém, ao fazer isso no Form preenchendo as combos e clicando no botão "Alterar Cadastro" deu erro '13' nessa linha do código...

 

[Visitante]

 

Disponibilize o seu arquivo Excel.