Página 1 de 1

CONTADOR AUTOMÁTICO CONFORME O DIA, MÊS, ANO E CÉLULA PREENCHIDA.

Enviado: 11 Jan 2023 às 11:06
por GENECI
Bom dia!

Solicito a sua ajuda conforme o anexo.

Grato.

Re: CONTADOR AUTOMÁTICO CONFORME O DIA, MÊS, ANO E CÉLULA PREENCHIDA.

Enviado: 13 Jan 2023 às 10:09
por Foxtri
Bom dia.
Veja se era isso:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row = 10 And Target.Column = 8 Then
If Range("D4") = "" Then Range("D4") = DateSerial(Year(Date), Month(Date), 1): Exit Sub
ThisWorkbook.Names.Add Name:="XDIA", RefersTo:=Day(Range("D4").Value)
ThisWorkbook.Names.Add Name:="XMES", RefersTo:=Month(Date)
ThisWorkbook.Names.Add Name:="XANO", RefersTo:=Year(Date)
If Year(Range("D4")) = Application.Evaluate(ThisWorkbook.Names("XANO").Value) Then
Range("D4") = DateSerial(Application.Evaluate(ThisWorkbook.Names("XANO").Value), _
Application.Evaluate(ThisWorkbook.Names("XMES").Value), _
Application.Evaluate(ThisWorkbook.Names("XDIA").Value) + 1)
Else
ThisWorkbook.Names.Add Name:="XDIA", RefersTo:=1
ThisWorkbook.Names.Add Name:="XMES", RefersTo:=1
ThisWorkbook.Names.Add Name:="XANO", RefersTo:=Year(Date)
Range("D4") = DateSerial(Application.Evaluate(ThisWorkbook.Names("XANO").Value), _
Application.Evaluate(ThisWorkbook.Names("XMES").Value), _
Application.Evaluate(ThisWorkbook.Names("XDIA").Value))
End If
End If
End Sub

Re: CONTADOR AUTOMÁTICO CONFORME O DIA, MÊS, ANO E CÉLULA PREENCHIDA.

Enviado: 14 Jan 2023 às 13:20
por GENECI
Boa tarde!
Com o office 2016, não funcionou.

Grato.

Re: CONTADOR AUTOMÁTICO CONFORME O DIA, MÊS, ANO E CÉLULA PREENCHIDA.

Enviado: 17 Jan 2023 às 09:33
por Foxtri
Bom dia.
veja se essa opção resolve a sua necessidade.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row = 10 And Target.Column = 8 Then
If Range("H10") = "" Then Exit Sub
If Range("D4") = "" Then Range("D4") = DateSerial(Year(Date), Month(Date), 1): Exit Sub
[XFD1] = Day(Range("D4").Value)
[XFD2] = Month(Date)
[XFD3] = Year(Date)
If Year(Range("D4")) = [XFD3] Then
Range("D4") = DateSerial([XFD3], [XFD2], [XFD1] + 1)
Else
ThisWorkbook.Names.Add Name:="XDIA", RefersTo:=1
ThisWorkbook.Names.Add Name:="XMES", RefersTo:=1
ThisWorkbook.Names.Add Name:="XANO", RefersTo:=Year(Date)
[XFD1] = 1
[XFD2] = 1
[XFD3] = Year(Date)
Range("D4") = DateSerial([XFD3], [XFD2], [XFD1])
End If
End If
End Sub

Até
Foxtri

Re: CONTADOR AUTOMÁTICO CONFORME O DIA, MÊS, ANO E CÉLULA PREENCHIDA.

Enviado: 17 Jan 2023 às 09:38
por Foxtri
Olá
Corrigindo:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row = 10 And Target.Column = 8 Then
If Range("H10") = "" Then Exit Sub
If Range("D4") = "" Then Range("D4") = DateSerial(Year(Date), Month(Date), 1): Exit Sub
[XFD1] = Day(Range("D4").Value)
[XFD2] = Month(Date)
[XFD3] = Year(Date)
If Year(Range("D4")) = [XFD3] Then
Range("D4") = DateSerial([XFD3], [XFD2], [XFD1] + 1)
Else
[XFD1] = 1
[XFD2] = 1
[XFD3] = Year(Date)
Range("D4") = DateSerial([XFD3], [XFD2], [XFD1])
End If
End If
End Sub

Até
Foxtri

Re: CONTADOR AUTOMÁTICO CONFORME O DIA, MÊS, ANO E CÉLULA PREENCHIDA.

Enviado: 26 Jan 2023 às 14:51
por GENECI
Boa tarde! Foxtri

Os códigos não funcionaram, até inicia a contagem, porém não há sequência.

Grato.